0000| .LIST 0000| .TITLE "APPLE-II PASCAL 1.3 P-MACHINE" 0000| 0000| .ABSOLUTE 0000| 0000| .NOPATCHLIST 0000| 0000| 0000 RUNTIME .EQU 0 ; STANDARD PASCAL SYSTEM 0000| 0000| 0100 STACK .EQU 100 ; 6502 stack low addr 0000| 0000| ;================================================================= 0000| 0000| .INCLUDE LOC1.3:INTPDC1.3.TEXT 0000| ;--------------------------------------------------- 0000| ; Pascal system locations 0000| ;--------------------------------------------------- 0000| 0000| ; Zero page locations... 0000| 0040 Z40 .EQU 040 0000| 0000| 0050 BASE .EQU 050 ; BASE register 0000| 0052 MP .EQU 052 ; Markstack Pointer 0000| 0054 JTAB .EQU 054 ; Jump TABle pointer 0000| 0056 SEG .EQU 056 ; SEGment pointer 0000| 0058 IPC .EQU 058 ; Interpreter Program Counter 0000| 005A NP .EQU 05A ; New Pointer (top of data heap) 0000| 005C KP .EQU 05C ; program stacK Pointer 0000| 005E STRP .EQU 05E ; STRing Pointer 0000| 0060 CODEP .EQU 060 ; Lowest word used in aux RAM 0000| 0062 CODELOW .EQU 062 ; Lowest permissable value for CODEP 0000| 0000| 0064 Z64 .EQU 064 0000| 0066 Z66 .EQU 066 0000| 006E Z6E .EQU 06E 0000| 0070 Z70 .EQU 070 0000| 0072 SOURCE .EQU 072 0000| 0074 DEST .EQU 074 0000| 0076 Z76 .EQU 076 0000| 007E Z7E .EQU 07E 0000| 0080 Z80 .EQU 080 0000| 0082 Z82 .EQU 082 0000| 0084 Z84 .EQU 084 0000| 0086 Z86 .EQU 086 0000| 0088 Z88 .EQU 088 0000| 008A Z8A .EQU 08A 0000| 008C Z8C .EQU 08C 0000| 008E Z8E .EQU 08E 0000| 0090 Z90 .EQU 090 0000| 0092 Z92 .EQU 092 0000| 0094 Z94 .EQU 094 0000| 0096 Z96 .EQU 096 0000| 009A Z9A .EQU 09A 0000| 00B8 ZB8 .EQU 0B8 0000| 0000| 0000| 00E1 DSMODE .EQU 0E1 ; Downshift mode 0000| 00E4 RTPTR .EQU 0E4 ; Pointer to unit read table 0000| 00E6 WTPTR .EQU 0E6 ; Pointer to unit write table 0000| 00E8 UDJVP .EQU 0E8 ; Pointer to user driver jump vectors 0000| 00F8 FSYSCOM .EQU 0F8 ; Pointer to SYSCOM area 0000| 00FA CONFLGS .EQU 0FA ; Indicates which Type B char modes are active 0000| ; Bit7=STOP, Bit6=FLUSH, Bit0=Follow Cursor 0000| 00FB NLEFT .EQU 0FB 0000| 0000| ;--------------------------------------------------- 0000| ; Address of called assembly subroutine 0000| ;--------------------------------------------------- 0000| 009A SUB_ADR .EQU 09A 0000| 0000| ;--------------------------------------------------- 0000| ; Number of items to be relocated 0000| ;--------------------------------------------------- 0000| 00BA NUM_RELOC .EQU 0BA 0000| 0000| ;--------------------------------------------------- 0000| ; Set by GETBIG 0000| ;--------------------------------------------------- 0000| 0068 BIG .EQU 068 ; "Big" opcode parameter 0000| 0000| ;--------------------------------------------------- 0000| ; Set by TRVSTAT 0000| ;--------------------------------------------------- 0000| 006C PREVMP .EQU 06C ; Holds MP reg during traverse 0000| 0000| ;--------------------------------------------------- 0000| ; Comparison equates 0000| ; (SC prefix = set comparison) 0000| ;--------------------------------------------------- 0000| 0076 CP_TYPE .EQU 076 ; Comparison type 0000| 007E CP_OPR1 .EQU 07E ; 1st operand (addr or data) 0000| 007E SC_SETA .EQU 07E ; Addr of set A (on stack) 0000| 0080 CP_OPR2 .EQU 080 ; 2nd operand (addr or data) 0000| 0084 SC_SIZEA .EQU 084 ; Size of set A 0000| 0086 SC_SIZEB .EQU 086 ; Size of set B 0000| 0088 SC_MINAB .EQU 088 ; MIN(SizeA,SizeB) 0000| 008A SC_SETB .EQU 08A ; Addr of set B (on stack) 0000| 008E CP_RSLT .EQU 08E ; Comparison result 0000| 0090 SC_DIFAB .EQU 090 ; ABS(SizeB-SizeA) 0000| 0096 SC_RTN0 .EQU 096 ; Return address 0000| 0098 SC_RTN .EQU 098 ; Return address 0000| 0000| ;--------------------------------------------------- 0000| ; Equates dealing with subprograms 0000| ;--------------------------------------------------- 0000| 007E P_DICT .EQU 07E ; Pointer to proc dictionary 0000| 0082 PROCNUM .EQU 082 ; Procedure number 0000| 0084 OLD_KP .EQU 084 ; stacK Pnt before call 0000| 0086 P_A_TBL .EQU 086 ; Proc attribute table 0000| 0086 REL_VAL .EQU 086 ; Relocated address 0000| 0088 NEW_KP .EQU 088 ; stacK Pnt after call 0000| 008C S_NXTSEG .EQU 08C ; Pointer to next segment. 0000| 0090 SEGNUM .EQU 090 ; Segment number 0000| 0098 S_RET .EQU 098 ; Internal subr return addr 0000| 009A NXT_REF .EQU 09A ; Next self-reference 0000| 0000| ;--------------------------------------------------- 0000| ; FillChar equates 0000| ;--------------------------------------------------- 0000| 0068 FC_NUMCH .EQU 068 0000| 0074 FC_ADDR .EQU 074 0000| 0000| ;--------------------------------------------------- 0000| ; Locations used by floating point routines 0000| ;--------------------------------------------------- 0000| 007E FPWORK1 .EQU 07E ; Three work 0000| 0084 FPWORK2 .EQU 084 ; areas (four 0000| 008A FPWORK3 .EQU 08A ; bytes each). 0000| 0000| 0090 FP_TEMP .EQU 090 ; Temporary word 0000| 0000| 0000 F_SIGN .EQU 0 ; Sign 0000| 0001 F_EXP .EQU 1 ; Exponent 0000| 0002 F_MANT1 .EQU 2 ; Mantissa 0000| 0003 F_MANT2 .EQU 3 ; (four 0000| 0004 F_MANT3 .EQU 4 ; bytes) 0000| 0005 F_MANT4 .EQU 5 0000| 0000| 0092 F_RETN .EQU 092 ; Return address. 0000| 0000| ;--------------------------------------------------- 0000| ; Locations used by UnitRead and UnitWrite... 0000| ;--------------------------------------------------- 0000| 0080 U_BLKNM .EQU 080 ; Block number parameter. 0000| 0082 U_BFLN .EQU 082 ; Length parameter 0000| 0084 U_B_ADR .EQU 084 ; Buffer array address. 0000| 0084 U_R_ADR .EQU 084 ; UnitStatus result array address. 0000| 0086 U_TEMP .EQU 086 0000| 0088 U_DLE_FLG .EQU 088 ; DLE character read? 0000| 008A U_LF_FLG .EQU 08A ; LF character checking? 0000| 008C U_MODE .EQU 08C ; Mode parameter. 0000| 008C U_CONWD .EQU 08C ; UnitStatus control word. 0000| 008E U_UNIT .EQU 08E ; Unit number parameter. 0000| 0090 U_RD_ADR .EQU 090 ; Read driver address. 0000| 0094 U_WR_ADR .EQU 094 ; Write driver address. 0000| 0096 U_TEMP1 .EQU 096 ; Temp variable. 0000| 0098 U_NUMBK .EQU 098 ; # of blanks in DLE expand 0000| 0098 U_RTN .EQU 098 0000| 00A0 UN_DL_F .EQU 0A0 ; DLE flag for units 1..9 0000| 0000| ;--------------------------------------------------- 0000| ; Zero page variables used in BIOS/interpreter area 0000| ;--------------------------------------------------- 0000| 00D2 TT1 .EQU 0D2 0000| 00D3 TT2 .EQU 0D3 0000| 00D4 TT3 .EQU 0D4 0000| 0000| ;--------------------------------------------------- 0000| ; Relocate the cold-start code to location $6800. 0000| ;--------------------------------------------------- 0000| 0000 CS_SRC .EQU 0 ; Source address of code 0000| 0002 CS_DST .EQU 2 ; Destination of code. 0000| 008A C_S_RDPT .EQU 08A ; Pointer for disk read. 0000| 00BD C_S_PNT .EQU 0BD ; Pointer for zeroing. 0000| 00D0 C_S_SUMVL .EQU 0D0 ; Value of checksum 0000| 00C5 C_S_SLTPT .EQU 0C5 ; Pointer to I/O slot page. 0000| 6000 C_S_BUFFR .EQU 06000 ; Buffer for disk read. 0000| 6800 C_S_CODE .EQU 06800 ; Cld Strt code after reloc 0000| FBB3 ROM_VERSION .EQU 0FBB3 ; Version in ROM 0000| FBC0 ROM_IDBYTE .EQU 0FBC0 ; ID byte in ROM 0000| 0000| BB5C START_STACK .EQU 0BB5C ; Stack starts here and builds down. 0000| ;--------------------------------------------------- 0000| ; Segment Tables 0000| ;--------------------------------------------------- 0000| BB5E SEG_TYPE .EQU 0BB5E ; Entry = $FF for code, 0 for data. 0000| BB9E SEG_CALL .EQU 0BB9E ; # of times segment invoked. 0000| BC1E SEG_TOS .EQU 0BC1E ; Value of stack when called. 0000| BC9E SEG_ADDR .EQU 0BC9E ; Table of segment addresses 0000| 0000| ;--------------------------------------------------- 0000| ; System communications area (SYSCOM) variables 0000| ; (p.IV-50 of Pascal 1.3 Manual) 0000| ;--------------------------------------------------- 0000| BD1E IORSLT .EQU 0BD1E ; Err code returned by last I/O operation 0000| BD20 XEQERR .EQU 0BD20 ; Err code of last execution error 0000| BD22 SYSUNIT .EQU 0BD22 ; Bootup Pascal volume number 0000| BD26 GDIRP .EQU 0BD26 ; Pointer to most recent disk direc read 0000| BD28 BOMBP .EQU 0BD28 ; Pointer to activation rec of bad proc 0000| BD2A STKBASE .EQU 0BD2A ; Copy of BASE register 0000| BD2C LASTMP .EQU 0BD2C ; Copy of MP register 0000| BD2E BOMBPN .EQU 0BD2E ; Proc # when exec error occurs 0000| BD30 BOMBSN .EQU 0BD30 ; Segment # when exec error occurs 0000| BD32 ENDSTK .EQU 0BD32 ; Ptr to bottom of prog stack (high memory) 0000| BD34 BOMBIPC .EQU 0BD34 ; IPC value when execution err occurs 0000| BD70 EOF_CH .EQU 0BD70 ; End-of-File character 0000| BD7E SEG_TABLE .EQU 0BD7E ; Segment table fills out SYSCOM 0000| 0000| ;--------------------------------------------------- 0000| ; BF00 PAGE PERMANENTS 0000| ; (BIOS variables) 0000| ;--------------------------------------------------- 0000| BF0A CONCKVECTOR .EQU 0BF0A ; 4 BYTES 0000| BF0E SCRMODE .EQU 0BF0E 0000| BF0F LFFLAG .EQU 0BF0F 0000| BF11 CHKBUT0 .EQU 0BF11 ; See p. III-270 of 1.3 manual: 0000| ; = 128 to check button 0 on input 0000| ; = 0 to skip check of button 0 0000| BF12 CURSFLAG .EQU 0BF12 ; Display cursor flag. 0000| BF13 RANDL .EQU 0BF13 ; Random 0000| BF14 RANDH .EQU 0BF14 ; number. 0000| BF15 KEYCOUNT .EQU 0BF15 ; # chars ready in type-ahead. 0000| BF16 BREAK .EQU 0BF16 ; 2 bytes 0000| BF18 RPTR .EQU 0BF18 ; 1 byte 0000| BF19 WPTR .EQU 0BF19 ; 1 byte 0000| BF1A RETL .EQU 0BF1A ; Addr for return 0000| BF1B RETH .EQU RETL+1 ; from BIOS. 0000| BF1C SPCHAR .EQU 0BF1C ; 00 for ALL special character checking 0000| ; (see p.III-271) 01 = don't check for Apple screen stuff 0000| ; 02 = don't check for other screen stuff 0000| BF1D IBREAK .EQU 0BF1D ; Interp stores BREAK & SYSCOM addresses 0000| BF1F ISYSCOM .EQU 0BF1F ; for access by user routines. 0000| BF21 VERSION .EQU 0BF21 ; Version of system. (4 FOR APPLE 1.3) 0000| BF22 FLAVOR .EQU 0BF22 ; See page IV-8 in Pascal 1.3 manual. 0000| BF23 A_FTNPRO .EQU 0BF23 ; Pntr to FORTRAN protect area. 0000| BF27 SLTTYPS .EQU 0BF27 ; BF27..0BF2E contain the I/O slot types. 0000| BF2F XITLOC .EQU 0BF2F ; INTERP INITS THIS TO LOCATION OF XIT. 0000| BF31 COMPTYPE .EQU 0BF31 ; Computer type; see p. IV-9. 0000| BF33 DSK_FLG .EQU 0BF33 ; 0 if no large disk; 128 if present. 0000| 0000| BF56 FTNPRO .EQU 0BF56 ; FORTRAN protection uses BF56..BF7F 0000| ; Vendor boot devices can use BFC0..BFFF 0000| 0000| ;--------------------------------------------------- 0000| ; Apple //e hardware locations 0000| ;--------------------------------------------------- 0000| C000 KBD .EQU 0C000 ; Read keyboard 0000| C002 RDMAINRAM .EQU 0C002 ; Read from main RAM 0000| C003 RDCARDRAM .EQU 0C003 ; Read from auxiliary RAM 0000| C004 WRMAINRAM .EQU 0C004 ; Write to main RAM 0000| C005 WRCARDRAM .EQU 0C005 ; Write to auxiliary RAM 0000| C006 SETSLOTCXROM .EQU 0C006 ; Switch in slot Cx000 ROM 0000| C007 SETINTCXROM .EQU 0C007 ; Switch in internal Cx000 ROM 0000| C008 SETSTDZP .EQU 0C008 ; Switch in main stack/zp/lang.card 0000| C009 SETALTZP .EQU 0C009 ; Switch in aux stack/zp/lang.card 0000| C00F SETALTCHAR .EQU 0C00F ; Norm/inv LC, no flash 0000| C010 KBDSTRB .EQU 0C010 ; Clear keyboard strobe 0000| C011 RDLCBNK2 .EQU 0C011 ; >127 if LC BANK2 in use 0000| C013 RDRAMRD .EQU 0C013 ; >127 if main RAM read enabled 0000| C014 RDRAMWRT .EQU 0C014 ; >127 if main RAM write enabled 0000| C015 RDCXROM .EQU 0C015 ; >127 if ROM CX space enabled 0000| C01C RDPAGE2 .EQU 0C01C ; >127 if page 2 0000| C051 SETTXTMODE .EQU 0C051 ; Switch to text display mode 0000| C052 SETALLGRAPH .EQU 0C052 ; Set all graphic mode 0000| C054 TXTPAGE1 .EQU 0C054 ; Switch to text page 1 0000| C055 TXTPAGE2 .EQU 0C055 ; Switch to text page 2 0000| C057 SETHIRES .EQU 0C057 ; Set high res graphics 0000| C061 BUTN0 .EQU 0C061 ; >127 if button 0 pressed 0000| C081 ROMIN .EQU 0C081 ; Swap in D000-FFFF ROM 0000| C083 LCBANK2 .EQU 0C083 ; Swap in LC bank 2 0000| C08B LCBANK1 .EQU 0C08B ; Swap in LC bank 1 0000| 0000| ;--------------------------------------- 0000| ; BIOS addresses 0000| ;--------------------------------------- 0000| D000 DWRITE .EQU 0D000 0000| D003 DREAD .EQU 0D003 0000| D899 CONCK .EQU 0D899 0000| D9F8 CINIT .EQU 0D9F8 0000| DA27 PINIT .EQU 0DA27 0000| DA3F GRINIT .EQU 0DA3F 0000| DA43 RINIT .EQU 0DA43 0000| DA84 DINIT .EQU 0DA84 0000| DA9F CWRITE .EQU 0DA9F 0000| DAD1 PWRITE .EQU 0DAD1 0000| DB01 RWRITE .EQU 0DB01 0000| DB3B CREAD .EQU 0DB3B 0000| DB8A RREAD .EQU 0DB8A 0000| DBCA CSTAT .EQU 0DBCA 0000| DBFB PSTAT .EQU 0DBFB 0000| DC15 RSTAT .EQU 0DC15 0000| DC68 DSTATT .EQU 0DC68 0000| 0000| DA30 GENIT .EQU 0DA30 0000| DAC8 INVERT .EQU 0DAC8 0000| DD4D CKDSKSL .EQU 0DD4D 0000| DE71 FORM .EQU 0DE71 0000| DF2F HTABA .EQU 0DF2F 0000| 0000| 0000| 0000| ;================================================================= 0000| 2 blocks for procedure code 16849 words left 0000| .PROC PMACH1_3 Current memory available: 17499 0000| 0000| .INCLUDE LOC1.3:INTERP1.3A.TEXT 0000| .ORG 0D000 D000| D000| ;--------------------------------------------------- D000| ; P-Code Instruction Table: D000| ;--------------------------------------------------- D000| **** **** **** **** JMPTBL .WORD ABI,ABR,ADI,ADR,LAND,DIF,DVI,DVR,CHK,FLO D008| **** **** **** **** D010| **** **** D014| **** **** **** **** .WORD FLT,INN,INT,LOR,MODI,MPI,MPR,NGI,NGR,LNOT D01C| **** **** **** **** D024| **** **** D028| **** **** **** **** .WORD SRS,SBI,SBR,SGS,SQI,SQR,STO,IXS,UNI,LDE D030| **** **** **** **** D038| **** **** D03C| **** **** **** **** .WORD CSP,LDCN,ADJ,FJP,P_INC,IND,IXA,LAO,LSA,LAE D044| **** **** **** **** D04C| **** **** D050| **** **** **** **** .WORD MOV,LDO,SAS,SRO,XJP,RNP,CIP,EQU,GEQ,GRT D058| **** **** **** **** D060| **** **** D064| **** **** **** **** .WORD P_LDA,LDC,LEQ,LES,LOD,NEQ,STR,UJP,LDP,STP D06C| **** **** **** **** D074| **** **** D078| **** **** **** **** .WORD LDM,STM,LDB,STB,IXP,RBP,CBP,EQUI,GEQI,GTRI D080| **** **** **** **** D088| **** **** D08C| **** **** **** **** .WORD LLA,LDCI,LEQI,LESI,LDL,NEQI,STL,CXP,CLP,CGP D094| **** **** **** **** D09C| **** **** D0A0| **** **** **** **** .WORD LPA,STE,P_NOP,EFJ,NFJ,BPT,XIT,P_NOP D0A8| **** **** **** **** D0B0| D0B0| **** **** **** **** .WORD SLDL,SLDL,SLDL,SLDL,SLDL,SLDL,SLDL,SLDL D0B8| **** **** **** **** D0C0| **** **** **** **** .WORD SLDL,SLDL,SLDL,SLDL,SLDL,SLDL,SLDL,SLDL D0C8| **** **** **** **** D0D0| D0D0| **** **** **** **** .WORD SLDO,SLDO,SLDO,SLDO,SLDO,SLDO,SLDO,SLDO D0D8| **** **** **** **** D0E0| **** **** **** **** .WORD SLDO,SLDO,SLDO,SLDO,SLDO,SLDO,SLDO,SLDO D0E8| **** **** **** **** D0F0| D0F0| **** **** **** **** .WORD SIND0,SIND,SIND,SIND,SIND,SIND,SIND,SIND D0F8| **** **** **** **** D100| D100| ;--------------------------------------------------- D100| ; CSP routines: D100| ;--------------------------------------------------- D100| **** **** **** **** CSPTBL .WORD IOC,NEW,MVL,MVR,EXIT,UREAD,UWRT,IDS,TRS D108| **** **** **** **** D110| **** D112| **** **** **** **** .WORD TIM,FLC,SCN,USTAT,0,0,0,0,0,0 D11A| 0000 0000 0000 0000 D122| 0000 0000 D126| 0000 0000 **** **** .WORD 0,0,LDS,ULS,TNC,RND,SIN,COS,LOG,ATAN D12E| **** **** **** **** D136| **** **** D13A| **** **** **** **** .WORD LN,EXP,SQRT,MRK,RLS,IOR,UBUSY,POT,UWAIT,UCLR D142| **** **** **** **** D14A| **** **** D14E| **** **** .WORD HLT,MEMAV D152| D152| .PAGE D152| ;--------------------------------------------------- D152| ; Start of interpreter: jump to code which relocates D152| ; the "cold start" code into lower memory, then D152| ; executes the cold start. D152| ;--------------------------------------------------- D152| INT_START D152| 4C **** JMP LOAD_CS D155| D155| D155| ;--------------------------------------------------- D155| ; GETBIG: Extract a parameter from the code stream. D155| ; If the byte immediately after the current p-code D155| ; is positive then it is multiplied by two (to D155| ; convert it to a word pointer in the range 0..FE) D155| ; If this byte is negative then the next two bytes D155| ; are fetched and used as a two-byte word pointer. D155| ;--------------------------------------------------- D155| 8D 03C0 GETBIG STA RDCARDRAM ; Set up to read P-code RAM. D158| B1 58 LDA @IPC,Y ; Get [IPC]. D15A| 10** BPL $02 ; If negative, D15C| 85 69 STA BIG+1 ; save 1st byte D15E| E6 58 INC IPC ; IPC = IPC + 1. D160| D0** BNE $01 D162| E6 59 INC IPC+1 D164| B1 58 $01 LDA @IPC,Y ; Get [IPC], D166| 0A ASL A ; double it, D167| 85 68 STA BIG ; and store. D169| 26 69 ROL BIG+1 D16B| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D16E| 60 RTS D16F| ; First byte is positive: D16F| 0A $02 ASL A ; Double [IPC] D170| 85 68 STA BIG ; and store 0 D172| A9 00 LDA #0 ; in first byte. D174| 85 69 STA BIG+1 D176| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D179| 60 RTS D17A| D17A| ;--------------------------------------------------- D17A| ; This routine is the same as GETBIG, except the D17A| ; parameter is returned in the X- and Y- regs D17A| ; instead of BIG and BIG+1. D17A| ;--------------------------------------------------- D17A| GETBIGXY D17A| 8D 03C0 STA RDCARDRAM ; Set up to read P-code area. D17D| B1 58 LDA @IPC,Y ; Get [IPC]. D17F| 10** BPL $02 ; If negative, D181| AA TAX ; save 1st byte D182| E6 58 INC IPC ; IPC = IPC + 1. D184| D0** BNE $01 D186| E6 59 INC IPC+1 D188| B1 58 $01 LDA @IPC,Y ; Get [IPC], D18A| 0A ASL A ; double it, D18B| A8 TAY ; and store. D18C| 8A TXA D18D| 2A ROL A D18E| AA TAX D18F| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D192| 60 RTS D193| ; First byte is positive: D193| 0A $02 ASL A ; Double [IPC] D194| A8 TAY ; and store 0 D195| A2 00 LDX #0 ; in first byte. D197| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D19A| 60 RTS D19B| D19B| D19B| ;--------------------------------------------------- D19B| ; TRVSTAT: Traverse X static links where X is passed D19B| ; in the 6502 X-register. This is accomplished by D19B| ; replacing MP with the word pointed at by MP "x" D19B| ; times. D19B| ;--------------------------------------------------- D19B| A5 52 TRVSTAT LDA MP ; Move markstack D19D| 85 6C STA PREVMP ; pointer to temp D19F| A5 53 LDA MP+1 ; variables. D1A1| 85 6D STA PREVMP+1 D1A3| E0 00 CPX #0 ; If X-reg is 0, D1A5| F0** BEQ $02 ; all done! D1A7| A0 00 $01 LDY #0 ; Store next link D1A9| B1 6C LDA @PREVMP,Y ; in chain on D1AB| 85 7E STA Z7E ; top of temp D1AD| C8 INY ; variable. D1AE| B1 6C LDA @PREVMP,Y D1B0| 85 6D STA PREVMP+1 D1B2| A5 7E LDA Z7E D1B4| 85 6C STA PREVMP D1B6| CA DEX ; Stay in loop D1B7| D0EE BNE $01 ; until X is zero. D1B9| 60 $02 RTS ; Return to caller. D1BA| D1BA| D1BA| ;--------------------------------------------------- D1BA| ; CHKGDRP: Check to see if there is a pointer to a D1BA| ; directory block present on the heap. If so, de- D1BA| ; allocate the storage for it and return. Otherwise D1BA| ; do nothing and return. D1BA| ;--------------------------------------------------- D1BA| AD 26BD CHKGDRP LDA GDIRP ; If directory address D1BD| D0** BNE $01 ; is zero, just return. D1BF| AE 27BD LDX GDIRP+1 D1C2| D0** BNE $01 D1C4| 60 RTS D1C5| 85 5A $01 STA NP ; Copy address of beginning D1C7| AD 27BD LDA GDIRP+1 ; of directory into the D1CA| 85 5B STA NP+1 ; data heap register, D1CC| A9 00 LDA #0 ; deallocating memory. D1CE| 8D 26BD STA GDIRP D1D1| A9 00 LDA #0 D1D3| 8D 27BD STA GDIRP+1 D1D6| 60 RTS ; Return. D1D7| D1D7| D1D7| **** A_INTERP .WORD INTERP D1D9| ; Assembly language .INTERP references refer to this D1D9| ; table (see Pascal 1.3 manual page IV-10). D1D9| **** INTERP .WORD EXECERR D1DB| **** .WORD BIOS D1DD| 1EBD .WORD IORSLT ; Start of SYSCOM D1DF| 7E00 .WORD Z7E D1E1| D1E1| .PAGE D1E1| ;---------------------------------------------------- D1E1| ; The various execution errors jump to this area D1E1| ;---------------------------------------------------- D1E1| D1E1| A9 01 RNGERR LDA #1 ; 1 = Range error D1E3| 10** BPL EXECERR D1E5| D1E5| A9 02 NOPROC LDA #2 ; 2 = No procedure in segment table D1E7| 10** BPL EXECERR D1E9| D1E9| EXUNCALL D1E9| A9 03 LDA #3 ; 3 = Exit from uncalled procedure D1EB| 10** BPL EXECERR D1ED| D1ED| A9 00 STKOVFL LDA #0 ; Clear the D1EF| 8D 26BD STA GDIRP ; directory D1F2| 8D 27BD STA GDIRP+1 ; pointer. D1F5| 85 5A STA NP D1F7| 85 5C STA KP D1F9| A9 80 LDA #080 ; Program stack pointer = $8000 D1FB| 85 5D STA KP+1 D1FD| A9 62 LDA #062 ; Data heap pointer = $6200 D1FF| 85 5B STA NP+1 D201| A9 04 LDA #4 ; 4 = Stack overflow D203| 10** BPL EXECERR D205| D205| A9 05 INTOVFL LDA #5 ; 5 = Integer overflow (ever used?) D207| 10** BPL EXECERR D209| D209| A9 06 DIVBY0 LDA #6 ; 6 = Divide by zero D20B| 10** BPL EXECERR D20D| D20D| INTBYUSR D20D| A9 08 LDA #8 ; 8 = Program interrupted by user D20F| 10** BPL EXECERR D211| D211| SYSIOERR D211| A9 09 LDA #9 ; 9 = System I/O error D213| 10** BPL EXECERR D215| D215| A9 0A IOERR LDA #10. ; 10 = I/O error D217| 10** BPL EXECERR D219| D219| CODEOVFL D219| A9 80 LDA #080 ; Set current aux mem pointer D21B| 85 61 STA CODEP+1 ; to $80xx and lowest D21D| A9 62 LDA #062 ; permitted value to $62xx. D21F| 85 63 STA CODELOW+1 D221| A9 10 LDA #16. ; 16 = Codespace overflow D223| 10** BPL EXECERR D225| D225| ; Unimplemented instructions... D225| EFJ ; Equal False Jump D225| NFJ ; Not Equal False Jump D225| ATAN ; \ D225| COS ; \ Math D225| EXP ; \ functions D225| LN ; > implemented D225| LOG ; / in TRANSCENT D225| SIN ; / unit. D225| SQRT ; / D225| IDS ; IDSearch D225| TRS ; TreeSearch D225| A9 0B UNIMPL LDA #11. ; 11 = Unimplemented instruction D227| 10** BPL EXECERR D229| D229| A9 0C FLPTERR LDA #12. ; 12 = Floating-point error D22B| 10** BPL EXECERR D22D| D22D| A9 0D STROVFL LDA #13. ; 13 = String overflow D22F| 10** BPL EXECERR D231| D231| D231| ;---------------------------------------------------- D231| ; All execution errors eventually come down to here D231| ; for printing messages. D231| ;---------------------------------------------------- D231| 8D 20BD EXECERR STA XEQERR ; Save execution error #. D234| A9 00 LDA #0 D236| 8D 21BD STA XEQERR+1 D239| 8D 03C0 STA RDCARDRAM ; Set up to read P-code RAM. D23C| 38 SEC D23D| A5 54 LDA JTAB D23F| E9 02 SBC #2 ; Put pointer to ENTER IC D241| 85 9A STA NXT_REF ; into NXT_REF. D243| A5 55 LDA JTAB+1 D245| E9 00 SBC #0 D247| 85 9B STA NXT_REF+1 D249| 20 **** JSR COMPSR ; Compute a self-relative pointer. D24C| 38 SEC D24D| A5 58 LDA IPC ; Subtract this starting address D24F| E5 86 SBC REL_VAL ; from current IPC to get the D251| 8D 34BD STA BOMBIPC ; relative address. Store in D254| A5 59 LDA IPC+1 ; BOMBIPC. D256| E5 87 SBC REL_VAL+1 D258| 8D 35BD STA BOMBIPC+1 D25B| A0 00 LDY #0 D25D| B1 54 LDA @JTAB,Y ; From activation record, D25F| 8D 2EBD STA BOMBPN ; get procedure number D262| B1 56 LDA @SEG,Y D264| 8D 30BD STA BOMBSN ; and segment number. D267| 8C 2FBD STY BOMBPN+1 D26A| 8C 31BD STY BOMBSN+1 D26D| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D270| A9 00 LDA #0 ; Resume execution at D272| 85 90 STA SEGNUM ; Segment 0, D274| A9 02 LDA #2 ; Procedure 2. D276| 85 82 STA PROCNUM D278| 4C **** JMP CXP_1 D27B| D27B| D27B| ;---------------------------------------------------- D27B| ; UPIPC3: Increment the IPC register by 3. D27B| ;---------------------------------------------------- D27B| A5 58 UPIPC3 LDA IPC D27D| 18 CLC D27E| 69 03 ADC #3 D280| 85 58 STA IPC D282| 90** BCC MAINLOOP D284| E6 59 INC IPC+1 D286| B0** BCS MAINLOOP D288| D288| D288| ;---------------------------------------------------- D288| ; UPIPC2: Increment the IPC register by 2. D288| ;---------------------------------------------------- D288| A5 58 UPIPC2 LDA IPC D28A| 18 CLC D28B| 69 02 ADC #2 D28D| 85 58 STA IPC D28F| 90** BCC MAINLOOP D291| E6 59 INC IPC+1 D293| B0** BCS MAINLOOP D295| D295| D295| ;---------------------------------------------------- D295| ; SLDC p-code: pushes the op-code fetched onto the D295| ; evaluation stack (6502 stack). D295| ;---------------------------------------------------- D295| AA SLDC TAX D296| 98 TYA D297| 48 PHA D298| 8A TXA D299| 48 PHA D29A| E6 58 INC IPC D29C| D0** BNE $01 D29E| E6 59 INC IPC+1 D2A0| ; Do the MAINLOOP stuff! D2A0| B1 58 $01 LDA @IPC,Y D2A2| 10F1 BPL SLDC D2A4| 0A ASL A D2A5| 8D **** STA $02+1 D2A8| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D2AB| 6C 00D0 $02 JMP @JMPTBL ; {Address modified before jump} D2AE| D2AE| D2AE| ;---------------------------------------------------- D2AE| ; UPIPC1: Increment the IPC register by 1. D2AE| ;---------------------------------------------------- D2AE| P_NOP ; This is also a NOP p-code D2AE| E6 58 UPIPC1 INC IPC D2B0| D0** BNE MAINLOOP D2B2| E6 59 INC IPC+1 ; Fall thru to main loop. D2B4| D2B4| .PAGE D2B4| ;**************************************************** D2B4| ; D2B4| ; I N T E R P R E T E R M A I N L O O P D2B4| ; D2B4| ; Fetch an op-code from the location pointed at by D2B4| ; the IPC. If the high order bit is zero, transfer D2B4| ; to SDLC. Otherwise multiply by two and use as D2B4| ; index into jump table at $D000. D2B4| ; D2B4| ;**************************************************** D2B4| 8D 03C0 MAINLOOP STA RDCARDRAM ; Set up to read P-code RAM. D2B7| A0 00 LDY #0 ; Fetch operation code D2B9| B1 58 LDA @IPC,Y ; from p-code area. D2BB| 10D8 BPL SLDC ; If 0..128, it's a short load. D2BD| 0A ASL A ; Double op-code and store in D2BE| 8D **** STA $01+1 ; jump instruction D2C1| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D2C4| 6C 00D0 $01 JMP @JMPTBL ; Go to action routine D2C7| ; { Address modified before jump } D2C7| D2C7| D2C7| ;---------------------------------------------------- D2C7| ; FALSE JUMP: FJP SB D2C7| ; Jump (as described for UJP) if tos is FALSE. D2C7| ;---------------------------------------------------- D2C7| ; FJP p-code: emulates the p-machine false jump D2C7| ; instruction. A word is popped off the stack. If D2C7| ; the low order bit = 1, FJP jumps to UPIPC2. D2C7| ; Otherwise control drops through to UJP. D2C7| ;---------------------------------------------------- D2C7| 68 FJP PLA D2C8| 29 01 AND #1 D2CA| F0** BEQ $01 D2CC| 68 PLA D2CD| 4C 88D2 JMP UPIPC2 D2D0| D2D0| 68 $01 PLA D2D1| D2D1| D2D1| ;--------------------------------------------------- D2D1| ; UNCONDITIONAL JUMP: UJP SB D2D1| ; SB is a jumpp offset. If this D2D1| ; offset is nonnegative (a jump of less than 128 D2D1| ; bytes forward), it is simply added to the IPC D2D1| ; register. If SB is negative, then SB is used as D2D1| ; a byte offset into the jump table within the D2D1| ; attribute table pointed to by the JTAB register, D2D1| ; and the IPC register is set to the byte address D2D1| ; (JTAB[SB] - contents of (JTAB[SB]). D2D1| ;--------------------------------------------------- D2D1| ; UJP p-code: Emulates the p-machine unconditional D2D1| ; jump. The byte immediately following the opcode D2D1| ; is fetched. If it is positive then this value is D2D1| ; added to the IPC and control is transferred back D2D1| ; to the main loop. If the byte following the opcode D2D1| ; is negative then control is transferred to the D2D1| ; INJTAB routine where the minus value is used as D2D1| ; and index into the jump table for the current D2D1| ; procedure. The address in the jump table is D2D1| ; subtracted from the address of the jump table and D2D1| ; this value is placed in the IPC. Control is passed D2D1| ; back to the main interpreter loop. D2D1| ;--------------------------------------------------- D2D1| 18 UJP CLC D2D2| 8D 03C0 STA RDCARDRAM ; Set up to read P-code RAM. D2D5| A0 01 LDY #1 D2D7| B1 58 LDA @IPC,Y D2D9| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D2DC| 30** BMI $01 D2DE| D2DE| 65 58 ADC IPC D2E0| 85 58 STA IPC D2E2| 90A4 BCC UPIPC2 D2E4| E6 59 INC IPC+1 D2E6| 4C 88D2 JMP UPIPC2 D2E9| D2E9| ; Jump address is negative. Get value from jump table. D2E9| 65 54 $01 ADC JTAB D2EB| 85 7E STA Z7E D2ED| A9 FF LDA #255. D2EF| 65 55 ADC JTAB+1 D2F1| 85 7F STA Z7E+1 D2F3| A5 7E LDA Z7E D2F5| 38 SEC D2F6| A0 00 LDY #0 D2F8| 8D 03C0 STA RDCARDRAM ; Set up to read P-code RAM. D2FB| F1 7E SBC @Z7E,Y D2FD| 85 58 STA IPC D2FF| A5 7F LDA Z7E+1 D301| C8 INY D302| F1 7E SBC @Z7E,Y D304| 85 59 STA IPC+1 D306| 4C B4D2 JMP MAINLOOP D309| D309| D309| ;--------------------------------------------------- D309| ; LOAD constant NIL: LDCN D309| ;--------------------------------------------------- D309| ; LDCN p-code: Pushes the value for NIL (0) onto the D309| ; stack. D309| ;--------------------------------------------------- D309| A9 00 LDCN LDA #0 D30B| 48 PHA D30C| 48 PHA D30D| 4C AED2 JMP UPIPC1 D310| D310| D310| ;--------------------------------------------------- D310| ; LOAD ONE-WORD CONSTANT: LDCI W D310| ;--------------------------------------------------- D310| ; LDCI p-code: Fetches the two bytes that follow in D310| ; the code stream and pushes them onto the evaluation D310| ; stack. The high-order byte is pushed first, low- D310| ; order byte last. D310| ;--------------------------------------------------- D310| A0 02 LDCI LDY #2 D312| 8D 03C0 STA RDCARDRAM ; Set up to read P-code RAM. D315| B1 58 LDA @IPC,Y D317| 48 PHA D318| 88 DEY D319| B1 58 LDA @IPC,Y D31B| 48 PHA D31C| 4C 7BD2 JMP UPIPC3 D31F| D31F| D31F| ;--------------------------------------------------- D31F| ; SHORT LOAD LOCAL WORD: SLDL_1 .. SLDL_16 D31F| ; For an instruction SSLDL_x, fetch the word with D31F| ; offset x in the data area of the executing D31F| ; procedure's activiation record and push it. D31F| ;--------------------------------------------------- D31F| ; SLDL n p-code: Upon entry, the Accumulator contains D31F| ; the opcode shifted to the left (* 2). 163 is D31F| ; subtracted from this value, leaving a value in D31F| ; the range 13 .. 43. The word at address MP+Acc is D31F| ; pushed onto the evaluation stack. (MP is 12 bytes D31F| ; long, followed by functional values, parameters, D31F| ; and local varables. D31F| ;--------------------------------------------------- D31F| E9 A3 SLDL SBC #163. D321| A8 TAY D322| B1 52 LDA @MP,Y D324| 48 PHA D325| 88 DEY D326| B1 52 LDA @MP,Y D328| 48 PHA D329| 4C AED2 JMP UPIPC1 D32C| D32C| D32C| ;--------------------------------------------------- D32C| ; LOAD LOCAL WORD: LDL B D32C| ; Fetch the word with offset B in the data area of D32C| ; the executing procedure's activation record and D32C| ; push it. D32C| ;--------------------------------------------------- D32C| ; LDL p-code: Loads a local variable from the current D32C| ; activation record. It begins by fetching a "big" D32C| ; parameter immediately after the opcode which returns D32C| ; the byte offset into the activation record. This D32C| ; byte offset is added with the MP register and the D32C| ; word pointer at by this sum is pushed onto the D32C| ; 6502 stack. D32C| ;--------------------------------------------------- D32C| A0 01 LDL LDY #1 D32E| 20 7AD1 JSR GETBIGXY D331| 18 CLC D332| 98 TYA D333| 65 52 ADC MP D335| 85 6E STA Z6E D337| 8A TXA D338| 65 53 ADC MP+1 D33A| 85 6F STA Z6E+1 D33C| A0 0B LDY #11. D33E| B1 6E LDA @Z6E,Y D340| 48 PHA D341| 88 DEY D342| B1 6E LDA @Z6E,Y D344| 48 PHA D345| 4C 88D2 JMP UPIPC2 D348| D348| D348| ;--------------------------------------------------- D348| ; LOAD LOCAL ADDRESS: LLA B D348| ; Fetch the address of the word with offset B in D348| ; the data area of the executing procedure's D348| ; activation record. D348| ;--------------------------------------------------- D348| ; LLA p-code: Quite similar to the LDL routine, D348| ; except the address of a local word (rather than D348| ; the data at that address) is pushed onto the D348| ; stack. It calls GETBIGXY to fetch the one or two D348| ; byte parameter that follows the opcode. This value D348| ; is added to MP and D348| ; this sum is saved. Finally the value 10 is added D348| ; to this sum (10 is the size of the activation D348| ; record minus two) and the result is pushed onto D348| ; the stack. D348| ;--------------------------------------------------- D348| A0 01 LLA LDY #1 D34A| 20 7AD1 JSR GETBIGXY D34D| 18 CLC D34E| 98 TYA D34F| 65 52 ADC MP D351| A8 TAY D352| 8A TXA D353| 65 53 ADC MP+1 D355| AA TAX D356| 18 CLC D357| 98 TYA D358| 69 0A ADC #10. D35A| A8 TAY D35B| 90** BCC $01 D35D| E8 INX D35E| 8A $01 TXA D35F| 48 PHA D360| 98 TYA D361| 48 PHA D362| 4C 88D2 JMP UPIPC2 D365| D365| D365| ;--------------------------------------------------- D365| ; STORE LOCAL WORD: STL B D365| ; Store tos into word with offset B in the data D365| ; area of the executing procedure's activiation rec. D365| ;--------------------------------------------------- D365| ; STL p-code: Fetches "big" param, calculates address D365| ; of the data where TOS is to be stored (the same D365| ; way as LDL and LLA), and stores the data on TOS D365| ; at that location. D365| ;--------------------------------------------------- D365| A0 01 STL LDY #1 D367| 20 7AD1 JSR GETBIGXY D36A| 18 CLC D36B| 98 TYA D36C| 65 52 ADC MP D36E| 85 6E STA Z6E D370| 8A TXA D371| 65 53 ADC MP+1 D373| 85 6F STA Z6E+1 D375| A0 0A LDY #10. D377| 68 PLA D378| 91 6E STA @Z6E,Y D37A| C8 INY D37B| 68 PLA D37C| 91 6E STA @Z6E,Y D37E| 4C 88D2 JMP UPIPC2 D381| D381| D381| ;--------------------------------------------------- D381| ; SHORT LOAD GLOBAL WORD: SLDO_1 .. SLDO_16 D381| ; For an instruction SLDO_x, fetch the word with D381| ; offset x in the data area of the activation D381| ; record of the base procedure and push it. D381| ;--------------------------------------------------- D381| ; SLDO n p-code: Loads one of the first 16 words of D381| ; global storage onto the stack. Upon entry the D381| ; Accumulator contains the SLDOn opcode * 2 MOD 256 D381| ; (a value in the range $D0..$EF). $C3 is subtracted D381| ; from this value to obtain an index in the range D381| ; 13..43 which is used as an index off of BASE to D381| ; obtain a pointer to the word to be pushed. The D381| ; word pointed at by BASE plus this index is pushed D381| ; onto the evaluation stack. D381| ;--------------------------------------------------- D381| E9 C3 SLDO SBC #0C3 D383| A8 TAY D384| B1 50 LDA @BASE,Y D386| 48 PHA D387| 88 DEY D388| B1 50 LDA @BASE,Y D38A| 48 PHA D38B| 4C AED2 JMP UPIPC1 D38E| D38E| D38E| ;--------------------------------------------------- D38E| ; LOAD GLOBAL WORD: LDO B D38E| ; Fetch the word with offset B in the data area of D38E| ; the activation record of the base procedure and D38E| ; push it. D38E| ;--------------------------------------------------- D38E| ; LDO p-code: Loads a global variable onto the stack. D38E| ; It is identical to LDL except the indexing is D38E| ; performed off of BASE register instead of MP. D38E| ;--------------------------------------------------- D38E| A0 01 LDO LDY #1 D390| 20 7AD1 JSR GETBIGXY D393| 18 CLC D394| 98 TYA D395| 65 50 ADC BASE D397| 85 6E STA Z6E D399| 8A TXA D39A| 65 51 ADC BASE+1 D39C| 85 6F STA Z6E+1 D39E| A0 0B LDY #11. D3A0| B1 6E LDA @Z6E,Y D3A2| 48 PHA D3A3| 88 DEY D3A4| B1 6E LDA @Z6E,Y D3A6| 48 PHA D3A7| 4C 88D2 JMP UPIPC2 D3AA| D3AA| D3AA| ;--------------------------------------------------- D3AA| ; LOAD GLOBAL ADDRESS: LAO B D3AA| ; Fetch the address of the word with offset B in D3AA| ; the data area of the activation record of the D3AA| ; base procedure and push it. D3AA| ;--------------------------------------------------- D3AA| ; LAO p-code: Loads the address of a global variable D3AA| ; onto the stack. It is identical to LLA except the D3AA| ; indexing is performed off of BASE register instead D3AA| ; of MP. D3AA| ;--------------------------------------------------- D3AA| A0 01 LAO LDY #1 D3AC| 20 7AD1 JSR GETBIGXY D3AF| 18 CLC D3B0| 98 TYA D3B1| 65 50 ADC BASE D3B3| A8 TAY D3B4| 8A TXA D3B5| 65 51 ADC BASE+1 D3B7| AA TAX D3B8| 18 CLC D3B9| 98 TYA D3BA| 69 0A ADC #10. D3BC| A8 TAY D3BD| 90** BCC $01 D3BF| E8 INX D3C0| 8A $01 TXA D3C1| 48 PHA D3C2| 98 TYA D3C3| 48 PHA D3C4| 4C 88D2 JMP UPIPC2 D3C7| D3C7| D3C7| ;--------------------------------------------------- D3C7| ; STORE GLOBAL WORD: SRO B D3C7| ; Store tos into the word with offset B in the data D3C7| ; area of the activation record of the base proc. D3C7| ;--------------------------------------------------- D3C7| ; SRO p-code: Stores word on TOS into the global D3C7| ; variable whose word offset foillows the opcode. D3C7| ; It is identical to STL except the indexing is D3C7| ; performed off of BASE register instead of MP. D3C7| ;--------------------------------------------------- D3C7| A0 01 SRO LDY #1 D3C9| 20 7AD1 JSR GETBIGXY D3CC| 18 CLC D3CD| 98 TYA D3CE| 65 50 ADC BASE D3D0| 85 6E STA Z6E D3D2| 8A TXA D3D3| 65 51 ADC BASE+1 D3D5| 85 6F STA Z6E+1 D3D7| A0 0A LDY #10. D3D9| 68 PLA D3DA| 91 6E STA @Z6E,Y D3DC| C8 INY D3DD| 68 PLA D3DE| 91 6E STA @Z6E,Y D3E0| 4C 88D2 JMP UPIPC2 D3E3| D3E3| D3E3| ;--------------------------------------------------- D3E3| ; LOAD INTERMEDIATE WORD: LOD DB,B D3E3| ; Fetch the word with offset B in the activation D3E3| ; record found by traversing DB links in the D3E3| ; static chain, and push it. D3E3| ;--------------------------------------------------- D3E3| ; LOD p-code: Loads a word from an intermediate level D3E3| ; routine. Begins by fetching the number of lex D3E3| ; levels to descend and then calls a routine to D3E3| ; drop down that many static links. Upon return, D3E3| ; the PREVMP register contains a pointer to the D3E3| ; activation record of the procedure in mind. The D3E3| ; BIG parameter immediately after the static link D3E3| ; parameter is fetched and added to the value in D3E3| ; PREVMP. This value plus 10 is a pointer to the D3E3| ; word desired. The Y-register is loaded with 11 D3E3| ; (pointing at the high byte of the word to be D3E3| ; pushed) and the two bytes are pushed on the stack. D3E3| ;--------------------------------------------------- D3E3| 8D 03C0 LOD STA RDCARDRAM ; Set up to read P-code RAM. D3E6| A0 01 LDY #1 D3E8| B1 58 LDA @IPC,Y D3EA| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D3ED| AA TAX ; X = # of links to follow. D3EE| 20 9BD1 JSR TRVSTAT ; Put address into PREVMP. D3F1| A0 02 LDY #2 D3F3| 20 55D1 JSR GETBIG D3F6| A5 68 LDA BIG D3F8| 18 CLC D3F9| 65 6C ADC PREVMP D3FB| 85 6E STA Z6E D3FD| A5 69 LDA BIG+1 D3FF| 65 6D ADC PREVMP+1 D401| 85 6F STA Z6E+1 D403| A0 0B LDY #11. D405| B1 6E LDA @Z6E,Y D407| 48 PHA D408| 88 DEY D409| B1 6E LDA @Z6E,Y D40B| 48 PHA D40C| 4C 7BD2 JMP UPIPC3 D40F| D40F| D40F| ;--------------------------------------------------- D40F| ; LOAD INTERMEDIATE ADDRESS: LDA DB,B D40F| ; Fetch address of the word with offset B in the D40F| ; activation record found by traversing DB links D40F| ; in the static chain, and push it. D40F| ;--------------------------------------------------- D40F| ; LDA p-code: Loads the address of some intermediate D40F| ; variable onto the stack. Begins (just like LOD) D40F| ; by fetching the number of lex levels to traverse D40F| ; and dropping down that many static levels. The D40F| ; offset into this activation record (BIG) is D40F| ; fetched and added to the value of the PREVMP D40F| ; register. Ten is added to the sum (the width of D40F| ; the mark stack control word) and the resulting D40F| ; sum (which is the address of the desired word) D40F| ; is pushed. D40F| ;--------------------------------------------------- D40F| 8D 03C0 P_LDA STA RDCARDRAM ; Set up to read P-code RAM. D412| A0 01 LDY #1 D414| B1 58 LDA @IPC,Y D416| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D419| AA TAX ; X = # of links to follow. D41A| 20 9BD1 JSR TRVSTAT ; Put address into PREVMP. D41D| A0 02 LDY #2 D41F| 20 55D1 JSR GETBIG D422| A5 68 LDA BIG D424| 18 CLC D425| 65 6C ADC PREVMP D427| 85 6E STA Z6E D429| A5 69 LDA BIG+1 D42B| 65 6D ADC PREVMP+1 D42D| 85 6F STA Z6E+1 D42F| A5 6E LDA Z6E D431| 18 CLC D432| 69 0A ADC #10. D434| 85 6E STA Z6E D436| 90** BCC $01 D438| E6 6F INC Z6E+1 D43A| A5 6F $01 LDA Z6E+1 D43C| 48 PHA D43D| A5 6E LDA Z6E D43F| 48 PHA D440| 4C 7BD2 JMP UPIPC3 D443| D443| D443| ;--------------------------------------------------- D443| ; STORE INTERMEDIATE WORD: STR DB,B D443| ; Store tos into the word with offset B in the D443| ; activation record found by traversing DB links in D443| ; the static chain. D443| ;--------------------------------------------------- D443| ; STR p-code: Pops data on TOS and stores it into D443| ; the intermediate variable whose lex level and D443| ; offset are specified after the opcode. This D443| ; instruction operates identically to LOD except D443| ; the data is popped off of the stack and stored D443| ; into memory instead of vice versa. D443| ;--------------------------------------------------- D443| 8D 03C0 STR STA RDCARDRAM ; Set up to read P-code RAM. D446| A0 01 LDY #1 D448| B1 58 LDA @IPC,Y D44A| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D44D| AA TAX ; X = # of links to follow. D44E| 20 9BD1 JSR TRVSTAT ; Put address into PREVMP. D451| A0 02 LDY #2 D453| 20 55D1 JSR GETBIG D456| A5 68 LDA BIG D458| 18 CLC D459| 65 6C ADC PREVMP D45B| 85 6E STA Z6E D45D| A5 69 LDA BIG+1 D45F| 65 6D ADC PREVMP+1 D461| 85 6F STA Z6E+1 D463| A0 0A LDY #10. D465| 68 PLA D466| 91 6E STA @Z6E,Y D468| C8 INY D469| 68 PLA D46A| 91 6E STA @Z6E,Y D46C| 4C 7BD2 JMP UPIPC3 D46F| D46F| D46F| ;--------------------------------------------------- D46F| ; LOAD EXTENDED WORD: LDE UB,B D46F| ; Fetch the word with offset B in the data segment D46F| ; number UB (of an Intrinsic Unit) and push it. D46F| ;--------------------------------------------------- D46F| ; LDE p-code: LoaD Extended loads a word from the D46F| ; activation record of an intrinsic unit. The byte D46F| ; immediately following the opcode is fetched into D46F| ; the X-reg. This is the segment number from which D46F| ; the word is to be fetched. The BIG parameter D46F| ; following the segment number is fetched. Once the D46F| ; BIG parameter is fetched it is added to the D46F| ; address of the desired segment which is fetched D46F| ; by indexing off of SEG_ADDR with the value in the D46F| ; X-reg (segment # times 2). The word pointed at by D46F| ; this sum is pushed on the stack. D46F| ;--------------------------------------------------- D46F| 8D 03C0 LDE STA RDCARDRAM ; Set up to read P-code RAM. D472| A0 01 LDY #1 D474| B1 58 LDA @IPC,Y D476| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D479| 0A ASL A D47A| AA TAX D47B| C8 INY D47C| 20 55D1 JSR GETBIG D47F| BD 9EBC LDA SEG_ADDR,X D482| 18 CLC D483| 65 68 ADC BIG D485| 85 7E STA Z7E D487| BD 9FBC LDA SEG_ADDR+1,X D48A| 65 69 ADC BIG+1 D48C| 85 7F STA Z7E+1 D48E| A0 01 LDY #1 D490| B1 7E LDA @Z7E,Y D492| 48 PHA D493| 88 DEY D494| B1 7E LDA @Z7E,Y D496| 48 PHA D497| 4C 7BD2 JMP UPIPC3 D49A| D49A| D49A| ;--------------------------------------------------- D49A| ; STORE EXTENDED WORD: STE UB,B D49A| ; Store tos into the word with offset B in the data D49A| ; segment number UB (of an Intrinsic Unit). D49A| ;--------------------------------------------------- D49A| ; STE p-code: STore Extended is the converse of LDE. D49A| ; The difference is STE pops data off the stack and D49A| ; stores it into main memory instead of pushing D49A| ; data onto the stack. D49A| ;--------------------------------------------------- D49A| 8D 03C0 STE STA RDCARDRAM ; Set up to read P-code RAM. D49D| A0 01 LDY #1 D49F| B1 58 LDA @IPC,Y D4A1| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D4A4| 0A ASL A D4A5| AA TAX D4A6| C8 INY D4A7| 20 55D1 JSR GETBIG D4AA| BD 9EBC LDA SEG_ADDR,X D4AD| 18 CLC D4AE| 65 68 ADC BIG D4B0| 85 7E STA Z7E D4B2| BD 9FBC LDA SEG_ADDR+1,X D4B5| 65 69 ADC BIG+1 D4B7| 85 7F STA Z7E+1 D4B9| A0 00 LDY #0 D4BB| 68 PLA D4BC| 91 7E STA @Z7E,Y D4BE| C8 INY D4BF| 68 PLA D4C0| 91 7E STA @Z7E,Y D4C2| 4C 7BD2 JMP UPIPC3 D4C5| D4C5| D4C5| ;--------------------------------------------------- D4C5| ; LOAD EXTENDED ADDRESS: LAE UB,B D4C5| ; Fetch the address of the word with offset B in D4C5| ; the data segment number UB (of an Intrinsic Unit), D4C5| ; and push it. D4C5| ;--------------------------------------------------- D4C5| ; LAE p-code: Load Address, Extended, calculates the D4C5| ; address of a word within a different segment (the D4C5| ; same way as in LDE and STE) and then pushes the D4C5| ; address calculated onto the stack. D4C5| ;--------------------------------------------------- D4C5| 8D 03C0 LAE STA RDCARDRAM ; Set up to read P-code RAM. D4C8| A0 01 LDY #1 D4CA| B1 58 LDA @IPC,Y D4CC| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D4CF| 0A ASL A D4D0| AA TAX D4D1| C8 INY D4D2| 20 55D1 JSR GETBIG D4D5| BD 9EBC LDA SEG_ADDR,X D4D8| 18 CLC D4D9| 65 68 ADC BIG D4DB| A8 TAY D4DC| BD 9FBC LDA SEG_ADDR+1,X D4DF| 65 69 ADC BIG+1 D4E1| 48 PHA D4E2| 98 TYA D4E3| 48 PHA D4E4| 4C 7BD2 JMP UPIPC3 D4E7| D4E7| D4E7| ;--------------------------------------------------- D4E7| ; SHORT INDEX AND LOAD WORD: SIND_0 .. SIND_7 D4E7| ; For an instruction SIND_x, index the word pointer D4E7| ; tos by x words, and push the word pointed to by D4E7| ; the result. D4E7| ;--------------------------------------------------- D4E7| ; SIND n p-code: Short INDex and load handles the 8 D4E7| ; short load routines (SIND0 .. SIND7). The opcodes D4E7| ; (times 2 MOD 256) are in the range $F0 .. $FE. D4E7| ; This value is in the accumulator upon entry (and D4E7| ; the carry is set). $F0 is subtracted from the acc D4E7| ; to yield 0 .. $E, which is then transferred into D4E7| ; the Y-reg for use as an index. The word on TOS is D4E7| ; popped and stored into a zero page memory location. D4E7| ; Indexed indirect addressing is used to fetch the D4E7| ; word specified by the SIND n instruction. D4E7| ;--------------------------------------------------- D4E7| E9 F0 SIND SBC #0F0 D4E9| A8 TAY D4EA| ;--------------------------------------------------- D4EA| ; SIND0 p-code: Specific case of SIND, optimized D4EA| ; because it is used so frequently. The Y-reg = 0 D4EA| ; upon entry, so it avoids SBC and TAY instructions. D4EA| ;--------------------------------------------------- D4EA| 68 SIND0 PLA D4EB| 85 7E STA Z7E D4ED| 68 PLA D4EE| 85 7F STA Z7E+1 D4F0| C8 INY D4F1| B1 7E LDA @Z7E,Y D4F3| 48 PHA D4F4| 88 DEY D4F5| B1 7E LDA @Z7E,Y D4F7| 48 PHA D4F8| 4C AED2 JMP UPIPC1 D4FB| D4FB| D4FB| ;--------------------------------------------------- D4FB| ; STORE INDIRECT WORD: STO D4FB| ; Store tos into the word pointed to by tos-1. D4FB| ;--------------------------------------------------- D4FB| ; STO p-code: Store indirect pops two words off of D4FB| ; the stack and stores them into a pair of zero D4FB| ; page memory locations. The first word popped off D4FB| ; the stack is stored at the memory location pointed D4FB| ; at by the second word popped off of the stack. D4FB| ;--------------------------------------------------- D4FB| 68 STO PLA D4FC| 85 7E STA Z7E D4FE| 68 PLA D4FF| 85 7F STA Z7E+1 D501| 68 PLA D502| 85 80 STA Z80 D504| 68 PLA D505| 85 81 STA Z80+1 D507| A0 00 LDY #0 D509| A5 7E LDA Z7E D50B| 91 80 STA @Z80,Y D50D| C8 INY D50E| A5 7F LDA Z7E+1 D510| 91 80 STA @Z80,Y D512| 4C AED2 JMP UPIPC1 D515| D515| D515| D515| ;================================================================= D515| D515| .INCLUDE LOC1.3:INTERP1.3B.TEXT D515| ;--------------------------------------------------- D515| ; LOAD MULTIPLE-WORD CONSTANT: LDC UB, D515| ; Fetch the word-aligned of UB words in D515| ; reverse word order, and push the data. D515| ;--------------------------------------------------- D515| ; LDC p-code: The UB parameter which follows the LDC D515| ; (load multiple word constant) instruction is D515| ; fetched and saved in the X-reg. This value is also D515| ; incremented by one, multiplied by two, and then D515| ; stored into memory. This is the total number of D515| ; bytes required by this instruction (n words + D515| ; 1 byte UP value + 1 byte opcode). Next the IPC is D515| ; incremented by one if it is not on a word D515| ; boundary. Then the next 'UB' words are read D515| ; from the code stream and pushed onto the stack. D515| ; Finally, the value saved earlier is added to D515| ; the IPC and control is returned to the main loop. D515| ;--------------------------------------------------- D515| 8D 03C0 LDC STA RDCARDRAM ; Set up to read P-code RAM. D518| A0 01 LDY #1 D51A| B1 58 LDA @IPC,Y D51C| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D51F| AA TAX D520| A8 TAY D521| C8 INY D522| 98 TYA D523| 0A ASL A D524| 85 7E STA Z7E D526| A5 58 LDA IPC D528| 29 01 AND #1 D52A| F0** BEQ $01 D52C| E6 58 INC IPC D52E| D0** BNE $01 D530| E6 59 INC IPC+1 D532| A0 03 $01 LDY #3 D534| 8D 03C0 STA RDCARDRAM ; Set up to read P-code RAM. D537| B1 58 $02 LDA @IPC,Y D539| 48 PHA D53A| 88 DEY D53B| B1 58 LDA @IPC,Y D53D| 48 PHA D53E| C8 INY D53F| C8 INY D540| C8 INY D541| CA DEX D542| D0F3 BNE $02 D544| D544| A5 58 LDA IPC D546| 18 CLC D547| 65 7E ADC Z7E D549| 85 58 STA IPC D54B| 90** BCC $03 D54D| E6 59 INC IPC+1 D54F| 4C B4D2 $03 JMP MAINLOOP D552| D552| D552| ;--------------------------------------------------- D552| ; LOAD MULTIPLE WORDS: LDM UB D552| ; Fetch UB words of word-aligned data in reverse D552| ; order, whose beginning is pointed to by tos, and D552| ; push the block. D552| ;--------------------------------------------------- D552| ; LDM p-code: This routine begins by fetching the UB D552| ; parameter that follows the opcode. This value (the D552| ; number of words to push) is multiplied by two (to D552| ; get # bytes) and saved in a temp location. Then D552| ; the stack is checked to make sure there is enough D552| ; room on the stack to hold the data being pushed. D552| ; If not, the "stack overflow" exit is taken. When D552| ; there is enough room on the stack, a pointer to D552| ; the block of data to be pushed is popped off the D552| ; stack and saved. Finally, the UB words are D552| ; pushed onto the 6502 hardware stack. D552| ;--------------------------------------------------- D552| 8D 03C0 LDM STA RDCARDRAM ; Set up to read P-code RAM. D555| A0 01 LDY #1 D557| B1 58 LDA @IPC,Y D559| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D55C| 85 7E STA Z7E D55E| 0A ASL A D55F| A8 TAY D560| 85 80 STA Z80 D562| BA TSX D563| 8A TXA D564| D564| 38 SEC D565| E5 80 SBC Z80 D567| 90** BCC $02 ; Stack overflow! D569| E9 08 SBC #8 D56B| 90** BCC $02 ; Stack overflow! D56D| D56D| A6 7E LDX Z7E D56F| 88 DEY D570| 68 PLA D571| 85 72 STA SOURCE D573| 68 PLA D574| 85 73 STA SOURCE+1 D576| B1 72 $01 LDA @SOURCE,Y D578| 48 PHA D579| 88 DEY D57A| B1 72 LDA @SOURCE,Y D57C| 48 PHA D57D| 88 DEY D57E| CA DEX D57F| D0F5 BNE $01 D581| D581| 4C 88D2 JMP UPIPC2 D584| D584| 4C EDD1 $02 JMP STKOVFL D587| D587| ;--------------------------------------------------- D587| ; STORE MULTIPLE WORDS: STM UB D587| ; Transfer UB words of word-aligned data in reverse D587| ; order, whose beginning is pointed to by tos, to D587| ; the location block pointed to by tos-1. D587| ;--------------------------------------------------- D587| ; STM p-code: The store multiple words routine checks D587| ; the UB parameter that follows to find how many D587| ; words are to be stored into memory. UB*2 is used D587| ; as an index into the stack to find the pointer to D587| ; the memory area where TOS is to be stored,. The D587| ; UB words on TOS are popped and stored into the D587| ; memory locations described by the above pointer. D587| ; Finally, the pointer is removed from the stack D587| ; and control returns to the main loop. D587| ;--------------------------------------------------- D587| 8D 03C0 STM STA RDCARDRAM ; Set up to read P-code RAM. D58A| A0 01 LDY #1 D58C| B1 58 LDA @IPC,Y D58E| 8D 02C0 STA RDMAINRAM ; Reset reads to main RAM. D591| 85 7E STA Z7E D593| BA TSX D594| 8A TXA D595| 18 CLC D596| 65 7E ADC Z7E D598| 65 7E ADC Z7E D59A| AA TAX D59B| BD 0101 LDA STACK+1,X D59E| 85 74 STA DEST D5A0| BD 0201 LDA STACK+2,X D5A3| 85 75 STA DEST+1 D5A5| 88 DEY D5A6| A6 7E LDX Z7E D5A8| 4C **** JMP $02 D5AB| D5AB| 68 $01 PLA D5AC| 91 74 STA @DEST,Y D5AE| C8 INY D5AF| 68 PLA D5B0| 91 74 STA @DEST,Y D5B2| C8 INY D5B3| CA DEX D5B4| D0F5 $02 BNE $01 D5B6| D5B6| 68 PLA D5B7| 68 PLA D5B8| 4C 88D2 JMP UPIPC2 D5BB| D5BB| ;--------------------------------------------------- D5BB| ; LOAD BYTE: LDB D5BB| ; Index the byte pointed tos-1 by the integer index D5BB| ; tos, and push the byte (after zeroing high byte) D5BB| ; pointed to by the resulting byte pointer. D5BB| ;--------------------------------------------------- D5BB| ; LDB (load byte) p-code: TOS contains an index into D5BB| ; a byte array. TOS-1 is a pointer to the base addr D5BB| ; of a byte array. TOS is added to TOS-1 and the sum D5BB| ; a pointer to the byte to be pushed. A zero (for D5BB| ; the H.O. byte) is pushed followed by the byte D5BB| ; pointed at by the above mentioned sum. D5BB| ;--------------------------------------------------- D5BB| BA LDB TSX D5BC| 18 CLC D5BD| 68 PLA D5BE| 7D 0301 ADC STACK+3,X D5C1| 85 7E STA Z7E D5C3| 68 PLA D5C4| 7D 0401 ADC STACK+4,X D5C7| 85 7F STA Z7E+1 D5C9| 98 TYA D5CA| 9D 0401 STA STACK+4,X D5CD| B1 7E LDA @Z7E,Y D5CF| 9D 0301 STA STACK+3,X D5D2| 4C AED2 JMP UPIPC1 D5D5| D5D5| D5D5| ;--------------------------------------------------- D5D5| ; STORE BYTE: STB D5D5| ; Index the byte pointer tos-2 by the integer index D5D5| ; tos-1, and push the byte tos into the location D5D5| ; pointed to by the resulting byte pointer. D5D5| ;--------------------------------------------------- D5D5| 68 STB PLA D5D6| AA TAX D5D7| 68 PLA D5D8| 68 PLA D5D9| 85 7E STA Z7E D5DB| 68 PLA D5DC| 85 7F STA Z7E+1 D5DE| 18 CLC D5DF| 68 PLA D5E0| 65 7E ADC Z7E D5E2| 85 7E STA Z7E D5E4| 68 PLA D5E5| 65 7F ADC Z7E+1 D5E7| 85 7F STA Z7E+1 D5E9| 8A TXA D5EA| 91 7E STA @Z7E,Y D5EC| 4C AED2 JMP UPIPC1 D5EF| D5EF| ;--------------------------------------------------- D5EF| ; MOVE WORDS: MOV D5EF| ; Transfer a source block of B words, pointed to by D5EF| ; byte pointer tos, to a similar destination block D5EF| ; pointed to by byte pointer tos-1. D5EF| ;--------------------------------------------------- D5EF| ; MOV (move words) p-code: TOS (a pointer to a block D5EF| ; of B words) is popped and stored into memory. TOS-1 D5EF| ; (a pointer to a similar block of B words) is popped D5EF| ; and stored. Next, the BIG parameter that follows D5EF| ; the opcode is fetched, and the source data is D5EF| ; moved to the destination address. D5EF| ;--------------------------------------------------- D5EF| 68 MOV PLA D5F0| 85 72 STA SOURCE D5F2| 68 PLA D5F3| 85 73 STA SOURCE+1 D5F5| 68 PLA D5F6| 85 74 STA DEST D5F8| 68 PLA D5F9| 85 75 STA DEST+1 D5FB| A0 01 LDY #1 D5FD| 20 55D1 JSR GETBIG D600| 4C **** JMP DOMOV ; Jump into MoveLeft. D603| D603| D603| ;--------------------------------------------------- D603| ; LOGICAL AND: LAND D603| ; Push the result of tos-1 AND tos. This is a bitwise D603| ; AND of two 16-bit words. D603| ;--------------------------------------------------- D603| ; LAND (logical AND) p-code: The top two words on D603| ; the stack are, logically ANDed with one another D603| ; and left on top of the stack. D603| ;--------------------------------------------------- D603| BA LAND TSX ; Index into stack, D604| BD 0301 LDA STACK+3,X ; then AND top 2 D607| 3D 0101 AND STACK+1,X ; words, placing D60A| 9D 0301 STA STACK+3,X ; result in tos-1 word. D60D| BD 0401 LDA STACK+4,X D610| 3D 0201 AND STACK+2,X D613| 9D 0401 STA STACK+4,X D616| E8 INX ; Adjust stack pointer so D617| E8 INX ; result is on tos. D618| 9A TXS D619| 4C AED2 JMP UPIPC1 D61C| D61C| ;--------------------------------------------------- D61C| ; LOGICAL OR: LOR D61C| ; Push the result of tos-1 OR tos. This is a D61C| ; bitwise OR of two 16-bit words. D61C| ;--------------------------------------------------- D61C| ; LOR (logical OR) p-code: The top two words on D61C| ; the stack are, logically ORed with one another D61C| ; and left on top of the stack. D61C| ;--------------------------------------------------- D61C| BA LOR TSX D61D| BD 0301 LDA STACK+3,X D620| 1D 0101 ORA STACK+1,X D623| 9D 0301 STA STACK+3,X D626| BD 0401 LDA STACK+4,X D629| 1D 0201 ORA STACK+2,X D62C| 9D 0401 STA STACK+4,X D62F| E8 INX D630| E8 INX D631| 9A TXS D632| 4C AED2 JMP UPIPC1 D635| D635| D635| ;--------------------------------------------------- D635| ; LOGICAL NOT: LNOT D635| ; Push the one's complement of tos. This is a D635| ; bitwise negation of one 16-bit word. D635| ;--------------------------------------------------- D635| ; LNOT (logical NOT) p-code: The word on TOS is D635| ; popped, XORed with $FFFF (bits inverted), and D635| ; pushed back onto the stack. D635| ;--------------------------------------------------- D635| 68 LNOT PLA D636| AA TAX D637| 68 PLA D638| 49 FF EOR #0FF D63A| 48 PHA D63B| 8A TXA D63C| 49 FF EOR #0FF D63E| 48 PHA D63F| 4C AED2 JMP UPIPC1 D642| D642| .PAGE D642| ;--------------------------------------------------- D642| ; CASE JUMP: XJP W1,W2,,W3 D642| ; W1 is word-aligned and the minimum case selector D642| ; of the case table. W2 is the maximum case selector. D642| ; W3 is an unconditional jump offset past the case D642| ; table. The case table is (W2-W1+1) words long, D642| ; and contains self-relative pointers. D642| ; If tos, the case selector expression, is not in D642| ; the range W1..W2, then point the IPC register at D642| ; W3. Otherwise, use (tos-W1) as an index into the D642| ; case table, and set the IPC register to the byte D642| ; address (casetable[tos-W1]) minus the contents of D642| ; (casetable[tos-W1]), and continue execution. D642| ;--------------------------------------------------- D642| ; XJP (case jump) p-code: The jump index (on TOS) is D642| ; popped and compared to the first word-aligned word D642| ; following the SJP opcode. If TOS is < this value, D642| ; the IPC register is loaded with the address of the D642| ; 3rd word-aligned word following the XJP opcode and D642| ; control is transferred to the main loop. If TOS D642| ; is >= W1, it is compared to the 2nd word-aligned D642| ; word following the XJP instruction. If TOS > this D642| ; value then TOS is pointed at W2 and control is D642| ; transferred to the main loop. Otherwise, the value D642| ; (TOS-W1)*2 is used as an index into the table D642| ; which immediately follows the W3 value. The table D642| ; entry pointed at by this value is subtracted from D642| ; the address of the table entry. This difference D642| ; is loaded into the IPC and control is returned to D642| ; the main interpreter loop. D642| ;--------------------------------------------------- D642| 8D 03C0 XJP STA RDCARDRAM ; Set up to read p-code RAM. D645| A9 01 LDA #1 D647| 05 58 ORA IPC D649| 85 58 STA IPC D64B| 68 PLA D64C| 85 96 STA Z96 D64E| 68 PLA D64F| 85 97 STA Z96+1 D651| A0 02 LDY #2 D653| 51 58 EOR @IPC,Y D655| 30** BMI $01 D657| D657| B1 58 LDA @IPC,Y D659| C5 97 CMP Z96+1 D65B| 90** BCC $02 D65D| D0** BNE $06 D65F| D65F| 88 DEY D660| A5 96 LDA Z96 D662| D1 58 CMP @IPC,Y D664| B0** BCS $02 D666| 90** BCC $06 D668| D668| A5 97 $01 LDA Z96+1 D66A| 30** BMI $06 D66C| D66C| A0 04 $02 LDY #4 D66E| B1 58 LDA @IPC,Y D670| 45 97 EOR Z96+1 D672| 30** BMI $03 D674| D674| A5 97 LDA Z96+1 D676| D1 58 CMP @IPC,Y D678| 90** BCC $04 D67A| D0** BNE $06 D67C| D67C| 88 DEY D67D| B1 58 LDA @IPC,Y D67F| C5 96 CMP Z96 D681| B0** BCS $04 D683| 90** BCC $06 D685| D685| A5 97 $03 LDA Z96+1 D687| 10** BPL $06 D689| D689| 38 $04 SEC D68A| A0 01 LDY #1 D68C| A5 96 LDA Z96 D68E| F1 58 SBC @IPC,Y D690| 85 96 STA Z96 D692| A5 97 LDA Z96+1 D694| C8 INY D695| F1 58 SBC @IPC,Y D697| 85 97 STA Z96+1 D699| 06 96 ASL Z96 D69B| 26 97 ROL Z96+1 D69D| A5 58 LDA IPC D69F| 18 CLC D6A0| 65 96 ADC Z96 D6A2| 85 96 STA Z96 D6A4| A5 59 LDA IPC+1 D6A6| 65 97 ADC Z96+1 D6A8| 85 97 STA Z96+1 D6AA| A5 96 LDA Z96 D6AC| 18 CLC D6AD| 69 07 ADC #7 D6AF| 85 96 STA Z96 D6B1| 90** BCC $05 D6B3| E6 97 INC Z96+1 D6B5| A0 00 $05 LDY #0 D6B7| 38 SEC D6B8| A5 96 LDA Z96 D6BA| F1 96 SBC @Z96,Y D6BC| 85 58 STA IPC D6BE| A5 97 LDA Z96+1 D6C0| C8 INY D6C1| F1 96 SBC @Z96,Y D6C3| 85 59 STA IPC+1 D6C5| 4C B4D2 JMP MAINLOOP D6C8| D6C8| A5 58 $06 LDA IPC D6CA| 18 CLC D6CB| 69 05 ADC #5 D6CD| 85 58 STA IPC D6CF| 90** BCC $07 D6D1| E6 59 INC IPC+1 D6D3| 4C B4D2 $07 JMP MAINLOOP D6D6| D6D6| .PAGE D6D6| ;--------------------------------------------------- D6D6| ; NEW VARIABLE ALLOCATION: CSP 1 D6D6| ; tos is the size (in words) to allocate for the D6D6| ; variable, and tos-1 is a word pointer to a pointer D6D6| ; variable. If the GDIRP variable field is non-NIL, D6D6| ; set GDIRP to NIL. Store the NP register into the D6D6| ; word pointed to by tos-1, and increment the NP D6D6| ; register by tos words. D6D6| ;--------------------------------------------------- D6D6| ; NEW (CSP routine): Begins by checking to see if D6D6| ; space has been reserved on the stack for a directory. D6D6| ; If so, the directory space is deallocated. Next D6D6| ; it pops two words off the stack. The 1st is the D6D6| ; size (in words) of the variable being allocated, D6D6| ; the 2nd is the address of the pointer to the new D6D6| ; variable. The value in NP (new pointer register) D6D6| ; is stored into the pointer variable and then the D6D6| ; size value is added to NP. Finally, the NP and D6D6| ; KP pseudo-registers are compared to make sure D6D6| ; stack overflow has not occurred. D6D6| ;--------------------------------------------------- D6D6| 20 BAD1 NEW JSR CHKGDRP D6D9| 68 PLA D6DA| 85 7E STA Z7E D6DC| 68 PLA D6DD| 85 7F STA Z7E+1 D6DF| 68 PLA D6E0| 85 80 STA Z80 D6E2| 68 PLA D6E3| 85 81 STA Z80+1 D6E5| 06 7E ASL Z7E D6E7| 26 7F ROL Z7E+1 D6E9| A0 00 LDY #0 D6EB| A5 5A LDA NP D6ED| 91 80 STA @Z80,Y D6EF| C8 INY D6F0| A5 5B LDA NP+1 D6F2| 91 80 STA @Z80,Y D6F4| A5 5A LDA NP D6F6| 18 CLC D6F7| 65 7E ADC Z7E D6F9| 85 5A STA NP D6FB| A5 5B LDA NP+1 D6FD| 65 7F ADC Z7E+1 D6FF| 85 5B STA NP+1 D701| 38 SEC D702| A5 5C LDA KP D704| E5 5A SBC NP D706| A5 5D LDA KP+1 D708| E5 5B SBC NP+1 D70A| B0** BCS $01 D70C| D70C| 4C EDD1 JMP STKOVFL D70F| D70F| 4C 88D2 $01 JMP UPIPC2 D712| D712| D712| ;--------------------------------------------------- D712| ; MARK HEAP: CSP 31 D712| ; Set the GDIRP field to NIL, then store the NP D712| ; register into the word indicated by the word D712| ; pointer tos. D712| ;--------------------------------------------------- D712| ; MRK (MARK CSP routine): Check to see if space was D712| ; allocated on the top of heap for the directory. D712| ; If so, it is deallocated. Next a word pointer is D712| ; popped and the NP register is copied into the D712| ; word pointed at by this value. D712| ;--------------------------------------------------- D712| 20 BAD1 MRK JSR CHKGDRP D715| 68 PLA D716| 85 7E STA Z7E D718| 68 PLA D719| 85 7F STA Z7E+1 D71B| A0 00 LDY #0 D71D| A5 5A LDA NP D71F| 91 7E STA @Z7E,Y D721| C8 INY D722| A5 5B LDA NP+1 D724| 91 7E STA @Z7E,Y D726| 4C 88D2 JMP UPIPC2 D729| D729| D729| ;--------------------------------------------------- D729| ; RELEASE HEAP: CSP 32 D729| ; Set the GDIRP field to NIL, then store the word D729| ; indicated by the word pointer tos into the NP reg. D729| ;--------------------------------------------------- D729| ; RLS (RELEASE CSP routine): A word pointer is popped D729| ; off the TOS. The word pointed at are loaded into D729| ; the NP register and the directory pointer is set D729| ; to NIL. D729| ;--------------------------------------------------- D729| 68 RLS PLA D72A| 85 7E STA Z7E D72C| 68 PLA D72D| 85 7F STA Z7E+1 D72F| A0 00 LDY #0 D731| B1 7E LDA @Z7E,Y D733| 85 5A STA NP D735| C8 INY D736| B1 7E LDA @Z7E,Y D738| 85 5B STA NP+1 D73A| A9 00 LDA #0 D73C| 8D 26BD STA GDIRP D73F| A9 00 LDA #0 D741| 8D 27BD STA GDIRP+1 D744| 4C 88D2 JMP UPIPC2 D747| D747| .PAGE D747| ;--------------------------------------------------- D747| ; EXIT THE OPERATING SYSTEM: XIT D747| ; Do a cold start of the system, as the operating D747| ; system's Quit command. D747| ;--------------------------------------------------- D747| ; XIT p-code: Stores the instructions LDA 0C08A, D747| ; JMP (0FFFC) at locations 0 - 5, then executes D747| ; this code. This turns off the language card and D747| ; simulates a reset. D747| ;--------------------------------------------------- D747| A9 AD XIT LDA #0AD D749| 85 00 STA 0 D74B| A9 8A LDA #08A D74D| 85 01 STA 1 D74F| A9 C0 LDA #0C0 D751| 85 02 STA 2 D753| A9 6C LDA #06C D755| 85 03 STA 3 D757| A9 FC LDA #0FC D759| 85 04 STA 4 D75B| A9 FF LDA #0FF D75D| 85 05 STA 5 D75F| 4C 0000 JMP 0 D762| D762| D762| ;--------------------------------------------------- D762| ; ABSOLUTE VALUE OF INTEGER: ABI D762| ; Push the absolute value of the integer tos. The D762| ; result is undefined if tos is initially -32768. D762| ;--------------------------------------------------- D762| ; ABI (absolute value, integer) p-code: Pops the D762| ; value off TOS. If positive, it is pushed back onto D762| ; TOS. If negative, the two's complement is pushed D762| ; onto the stack. D762| ;--------------------------------------------------- D762| 68 ABI PLA D763| AA TAX D764| 68 PLA D765| 30** BMI $01 D767| 48 PHA D768| 8A TXA D769| 48 PHA D76A| 4C AED2 JMP UPIPC1 D76D| D76D| A8 $01 TAY D76E| 18 CLC D76F| 8A TXA D770| 49 FF EOR #0FF D772| 69 01 ADC #1 D774| AA TAX D775| 98 TYA D776| 49 FF EOR #0FF D778| 69 00 ADC #0 D77A| 48 PHA D77B| 8A TXA D77C| 48 PHA D77D| 4C AED2 JMP UPIPC1 D780| D780| D780| ;--------------------------------------------------- D780| ; ADD INTEGERS: ADI D780| ; Add tos and tos-1, and push the resulting sum. D780| ;--------------------------------------------------- D780| ; ADI (add integers) p-code: The two words on TOS D780| ; are added, with the sum placed onto the top of D780| ; the stack. D780| ;--------------------------------------------------- D780| BA ADI TSX D781| 18 CLC D782| BD 0301 LDA STACK+3,X D785| 7D 0101 ADC STACK+1,X D788| 9D 0301 STA STACK+3,X D78B| BD 0401 LDA STACK+4,X D78E| 7D 0201 ADC STACK+2,X D791| 9D 0401 STA STACK+4,X D794| E8 INX D795| E8 INX D796| 9A TXS D797| 4C AED2 JMP UPIPC1 D79A| D79A| D79A| ;--------------------------------------------------- D79A| ; NEGATE INTEGER: NGI D79A| ; Push the two's complement of tos. The result is D79A| ; undefined if tos is initially -32768. D79A| ;--------------------------------------------------- D79A| ; NGI (negate integer) p-code: The word on TOS is D79A| ; popped, negated, and then pushed back onto stack. D79A| ;--------------------------------------------------- D79A| 68 NGI PLA D79B| 49 FF EOR #0FF ; Take one's complement D79D| 18 CLC ; then add 1 to get D79E| 69 01 ADC #1 ; two's complement. D7A0| AA TAX D7A1| 68 PLA D7A2| 49 FF EOR #0FF D7A4| 69 00 ADC #0 D7A6| 48 PHA D7A7| 8A TXA D7A8| 48 PHA D7A9| 4C AED2 JMP UPIPC1 D7AC| D7AC| D7AC| ;--------------------------------------------------- D7AC| ; SUBTRACT INTEGERS: SBI D7AC| ; Subtract tos from tos-1, and push the resulting D7AC| ; difference. D7AC| ;--------------------------------------------------- D7AC| ; SBI (subtract integers) p-code: The integer on TOS D7AC| ; is subtracted from the integer on TOS-1 and the D7AC| ; difference is placed onto the top of stack. D7AC| ;--------------------------------------------------- D7AC| BA SBI TSX D7AD| 38 SEC D7AE| BD 0301 LDA STACK+3,X D7B1| FD 0101 SBC STACK+1,X D7B4| 9D 0301 STA STACK+3,X D7B7| BD 0401 LDA STACK+4,X D7BA| FD 0201 SBC STACK+2,X D7BD| 9D 0401 STA STACK+4,X D7C0| E8 INX D7C1| E8 INX D7C2| 9A TXS D7C3| 4C AED2 JMP UPIPC1 D7C6| D7C6| .PAGE D7C6| ;--------------------------------------------------- D7C6| ; Multiply routine: The integers at addresses $92/93 D7C6| ; and $96/97 are multiplied and the result is left D7C6| ; in locations $6E/6F. D7C6| ;--------------------------------------------------- D7C6| A9 00 MULTIPLY LDA #0 ; Clear D7C8| 85 6F STA Z6E+1 ; result D7CA| 85 6E STA Z6E ; (product). D7CC| A2 10 LDX #16. ; 16 bits in multiplier. D7CE| D7CE| 66 95 $01 ROR Z94+1 ; Check bit in D7D0| 66 94 ROR Z94 ; multiplier. D7D2| 90** BCC $02 ; If it is set, D7D4| A5 6E LDA Z6E ; add the D7D6| 18 CLC ; multiplicand D7D7| 65 92 ADC Z92 ; to the product. D7D9| 85 6E STA Z6E D7DB| A5 6F LDA Z6E+1 D7DD| 65 93 ADC Z92+1 D7DF| 85 6F STA Z6E+1 D7E1| 66 6F $02 ROR Z6E+1 ; Shift product and D7E3| 66 6E ROR Z6E ; multiplier to right. D7E5| 66 97 ROR Z96+1 D7E7| 66 96 ROR Z96 D7E9| CA DEX D7EA| D0E2 BNE $01 D7EC| D7EC| 60 RTS D7ED| D7ED| D7ED| D7ED| ;--------------------------------------------------- D7ED| ; MULTIPLY INTEGERS: MPI D7ED| ; Multiply tos and tos-1, and push the resulting D7ED| ; product. D7ED| ;--------------------------------------------------- D7ED| ; MPI (multiply integers) p-code: Two integers are D7ED| ; popped off the stack. If at least one is positive, D7ED| ; the Multiply routine is called and the product is D7ED| ; pushed. If the values are both negative, they are D7ED| ; both negated before being multiplied. D7ED| ;--------------------------------------------------- D7ED| 68 MPI PLA D7EE| 85 94 STA Z94 D7F0| 68 PLA D7F1| 85 95 STA Z94+1 D7F3| 30** BMI $01 D7F5| D7F5| 68 PLA D7F6| 85 92 STA Z92 D7F8| 68 PLA D7F9| 85 93 STA Z92+1 D7FB| 4C **** JMP $02 D7FE| D7FE| 68 $01 PLA D7FF| 85 92 STA Z92 D801| 68 PLA D802| 85 93 STA Z92+1 D804| 10** BPL $02 D806| D806| A5 94 LDA Z94 D808| 49 FF EOR #0FF D80A| 18 CLC D80B| 69 01 ADC #1 D80D| 85 94 STA Z94 D80F| A5 95 LDA Z94+1 D811| 49 FF EOR #0FF D813| 69 00 ADC #0 D815| 85 95 STA Z94+1 D817| A5 92 LDA Z92 D819| 49 FF EOR #0FF D81B| 18 CLC D81C| 69 01 ADC #1 D81E| 85 92 STA Z92 D820| A5 93 LDA Z92+1 D822| 49 FF EOR #0FF D824| 69 00 ADC #0 D826| 85 93 STA Z92+1 D828| 20 C6D7 $02 JSR MULTIPLY D82B| A5 97 LDA Z96+1 D82D| 48 PHA D82E| A5 96 LDA Z96 D830| 48 PHA D831| 4C AED2 JMP UPIPC1 D834| D834| D834| ;--------------------------------------------------- D834| ; SQUARE INTEGER: SQI D834| ; Square tos, and push the result. D834| ;--------------------------------------------------- D834| ; SQI (square integer) p-code: duplicates the TOS D834| ; and jumps to the MPI routine. D834| ;--------------------------------------------------- D834| BA SQI TSX D835| BD 0201 LDA STACK+2,X D838| 48 PHA D839| BD 0101 LDA STACK+1,X D83C| 48 PHA D83D| 4C EDD7 JMP MPI D840| D840| D840| ;--------------------------------------------------- D840| ; DVIMOD routine: Takes the word in locations $92/93 D840| ; and divides it by the signed integer in $90/91. D840| ; The remainder (MOD) is left in $92/93, the quotient D840| ; in $96/97. There is no check for over/underflow. D840| ;--------------------------------------------------- D840| A0 00 DVIMOD LDY #0 D842| 84 94 STY Z94 D844| 84 6E STY Z6E D846| 84 6F STY Z6E+1 D848| 84 96 STY Z96 D84A| 84 97 STY Z96+1 D84C| A5 90 LDA Z90 D84E| D0** BNE $01 D850| A5 91 LDA Z90+1 D852| D0** BNE $01 D854| 4C 09D2 JMP DIVBY0 D857| D857| A5 91 $01 LDA Z90+1 D859| 10** BPL $02 D85B| D85B| A5 90 LDA Z90 D85D| 49 FF EOR #0FF D85F| 18 CLC D860| 69 01 ADC #1 D862| 85 90 STA Z90 D864| A5 91 LDA Z90+1 D866| 49 FF EOR #0FF D868| 69 00 ADC #0 D86A| 85 91 STA Z90+1 D86C| E6 94 INC Z94 D86E| A5 93 $02 LDA Z92+1 D870| 10** BPL $03 D872| D872| A5 92 LDA Z92 D874| 49 FF EOR #0FF D876| 18 CLC D877| 69 01 ADC #1 D879| 85 92 STA Z92 D87B| A5 93 LDA Z92+1 D87D| 49 FF EOR #0FF D87F| 69 00 ADC #0 D881| 85 93 STA Z92+1 D883| C6 94 DEC Z94 D885| 38 $03 SEC D886| A5 92 LDA Z92 D888| E5 90 SBC Z90 D88A| A5 93 LDA Z92+1 D88C| E5 91 SBC Z90+1 D88E| B0** BCS $04 D890| 84 96 STY Z96 D892| 84 97 STY Z96+1 D894| A5 92 LDA Z92 D896| 85 92 STA Z92 D898| A5 93 LDA Z92+1 D89A| 85 93 STA Z92+1 D89C| 60 RTS D89D| D89D| 18 $04 CLC D89E| A2 10 LDX #16. D8A0| A5 93 LDA Z92+1 D8A2| D0** BNE $05 D8A4| D8A4| A5 90 LDA Z90 D8A6| 85 6F STA Z6E+1 D8A8| A5 91 LDA Z90+1 D8AA| 85 90 STA Z90 D8AC| A2 08 LDX #8 D8AE| 18 $05 CLC D8AF| 66 91 ROR Z90+1 D8B1| D0** BNE $07 D8B3| D8B3| 66 90 ROR Z90 D8B5| D0** BNE $08 D8B7| D8B7| 66 6F $06 ROR Z6E+1 D8B9| 66 6E ROR Z6E D8BB| A5 92 LDA Z92 D8BD| 38 SEC D8BE| E5 6E SBC Z6E D8C0| A8 TAY D8C1| A5 93 LDA Z92+1 D8C3| E5 6F SBC Z6E+1 D8C5| 90** BCC $09 D8C7| D8C7| 85 93 STA Z92+1 D8C9| 84 92 STY Z92 D8CB| 38 SEC D8CC| 26 96 ROL Z96 D8CE| 26 97 ROL Z96+1 D8D0| CA DEX D8D1| 18 CLC D8D2| D0E3 BNE $06 D8D4| D8D4| 60 RTS D8D5| D8D5| D8D5| 66 90 $07 ROR Z90 D8D7| 66 6F $08 ROR Z6E+1 D8D9| 66 6E ROR Z6E D8DB| 18 CLC D8DC| 26 96 $09 ROL Z96 D8DE| 26 97 ROL Z96+1 D8E0| CA DEX D8E1| D0CB BNE $05 D8E3| D8E3| 60 RTS D8E4| D8E4| D8E4| ;--------------------------------------------------- D8E4| ; DIVIDE INTEGERS: DVI D8E4| ; Divide tos-1 by tos and push the resulting D8E4| ; integer quotient (any remainder is discarded). D8E4| ; Division by 0 causes an execution error. D8E4| ;--------------------------------------------------- D8E4| ; DVI (divide integers) p-code: Pops 2 values from D8E4| ; the stack and calls DVIMOD to divide TOS-1 by TOS. D8E4| ; Upon return from DVIMOD, DVI checks to see if both D8E4| ; the divisor and dividend were of the same sign. D8E4| ; If not, the positive quotient is negated. Lastly, D8E4| ; the quotient is pushed onto the stack. D8E4| ;--------------------------------------------------- D8E4| 68 DVI PLA D8E5| 85 90 STA Z90 D8E7| 68 PLA D8E8| 85 91 STA Z90+1 D8EA| 68 PLA D8EB| 85 92 STA Z92 D8ED| 68 PLA D8EE| 85 93 STA Z92+1 D8F0| 20 40D8 JSR DVIMOD D8F3| A5 94 LDA Z94 D8F5| F0** BEQ $01 D8F7| D8F7| A5 96 LDA Z96 D8F9| 49 FF EOR #0FF D8FB| 18 CLC D8FC| 69 01 ADC #1 D8FE| 85 96 STA Z96 D900| A5 97 LDA Z96+1 D902| 49 FF EOR #0FF D904| 69 00 ADC #0 D906| 85 97 STA Z96+1 D908| A5 97 $01 LDA Z96+1 D90A| 48 PHA D90B| A5 96 LDA Z96 D90D| 48 PHA D90E| 4C AED2 JMP UPIPC1 D911| D911| D911| ;--------------------------------------------------- D911| ; MODULO INTEGERS: MODI D911| ; Divide tos-1 by tos and puth the resulting D911| ; remainder. D911| ;--------------------------------------------------- D911| ; MODI (modulo integers) p-code: Identical to DVI D911| ; except the remainder is pushed onto the stack. D911| ;--------------------------------------------------- D911| 68 MODI PLA D912| 85 90 STA Z90 D914| 68 PLA D915| 85 91 STA Z90+1 D917| 68 PLA D918| 85 92 STA Z92 D91A| 68 PLA D91B| 85 93 STA Z92+1 D91D| 20 40D8 JSR DVIMOD D920| A5 93 LDA Z92+1 D922| 48 PHA D923| A5 92 LDA Z92 D925| 48 PHA D926| 4C AED2 JMP UPIPC1 D929| D929| .PAGE D929| ;--------------------------------------------------- D929| ; CHECK AGAINST SUBRANGE BOUNDS: CHK D929| ; Ensure than tos-1<=tos-2<=tos, leaving tos-2 on D929| ; the stack. If conditions are not satisfied, give D929| ; an execution error. D929| ;--------------------------------------------------- D929| ; CHK (check subrange) p-code: Pops 2 words off the D929| ; stack and compares them to the new TOS value. If D929| ; TOS-1 <= TOS-2 <= TOS, control returns to the D929| ; main loop. Otherwise the bounds violation error D929| ; handler is called. D929| ;--------------------------------------------------- D929| 68 CHK PLA D92A| 85 7E STA Z7E D92C| 68 PLA D92D| 85 7F STA Z7E+1 D92F| 68 PLA D930| 85 80 STA Z80 D932| 68 PLA D933| 85 81 STA Z80+1 D935| BA TSX D936| BD 0101 LDA STACK+1,X D939| 85 82 STA Z82 D93B| BD 0201 LDA STACK+2,X D93E| 85 83 STA Z82+1 D940| 45 81 EOR Z80+1 D942| 30** BMI $01 D944| D944| A5 81 LDA Z80+1 D946| C5 83 CMP Z82+1 D948| 90** BCC $02 D94A| D0** BNE $05 ; Result is out of range. D94C| D94C| A5 82 LDA Z82 D94E| C5 80 CMP Z80 D950| B0** BCS $02 D952| 90** BCC $05 ; Result is out of range. D954| D954| A5 83 $01 LDA Z82+1 D956| 30** BMI $05 ; Result is out of range. D958| D958| A5 7F $02 LDA Z7E+1 D95A| 45 83 EOR Z82+1 D95C| 30** BMI $03 D95E| D95E| A5 83 LDA Z82+1 D960| C5 7F CMP Z7E+1 D962| 90** BCC $04 ; Result is in range. D964| D0** BNE $05 ; Result is out of range. D966| D966| A5 7E LDA Z7E D968| C5 82 CMP Z82 D96A| B0** BCS $04 ; Result is in range. D96C| 90** BCC $05 ; Result is out of range. D96E| D96E| A5 83 $03 LDA Z82+1 D970| 10** BPL $05 ; Result is out of range. D972| D972| 4C AED2 $04 JMP UPIPC1 ; Result is in range. D975| D975| 4C E1D1 $05 JMP RNGERR ; Result is out of range. D978| D978| D978| ;--------------------------------------------------- D978| ; Subroutine to find a string in the stack/heap space. D978| ; Put pointer in $7E/7F. Called from LPA and LSA. D978| ;--------------------------------------------------- D978| A5 5E FIND_S LDA STRP ; Move string pointer D97A| 85 7E STA Z7E ; reg to $7E/7F. D97C| A5 5F LDA STRP+1 D97E| 85 7F STA Z7E+1 D980| D980| A5 7F $01 LDA Z7E+1 ; If at end of list, D982| D0** BNE $02 ; return. D984| A5 7E LDA Z7E D986| D0** BNE $02 D988| 60 RTS D989| D989| A0 00 $02 LDY #0 ; If = IPC, this D98B| B1 7E LDA @Z7E,Y ; is the one we're D98D| C5 58 CMP IPC ; looking for! D98F| D0** BNE $03 D991| C8 INY D992| B1 7E LDA @Z7E,Y D994| C5 59 CMP IPC+1 D996| D0** BNE $03 D998| 60 RTS D999| D999| A0 02 $03 LDY #2 ; Bump to next D99B| B1 7E LDA @Z7E,Y ; element in D99D| AA TAX ; linked list. D99E| C8 INY D99F| B1 7E LDA @Z7E,Y D9A1| 85 7F STA Z7E+1 D9A3| 86 7E STX Z7E D9A5| 4C 80D9 JMP $01 ; Check next string. D9A8| D9A8| D9A8| ;--------------------------------------------------- D9A8| ; LOAD A PACKED ARRAY: LPA UB, D9A8| ; Push a word pointer to the packed array D9A8| ; onto the evaluation stack. As the packed array is D9A8| ; contained in the code segment, not in the stack/ D9A8| ; heap space, a copy of the array is pushed onto the D9A8| ; program stack. If this array has not previously D9A8| ; been pushed onto the stack during the curreintly D9A8| ; active procedure, copy onto the program D9A8| ; stack (add one space to the end of the array if D9A8| ; has an odd number of bytes); push a 16-bit D9A8| ; integer onto the program stack that points to the D9A8| ; first byte of the array in the procedure code; D9A8| ; push a 16-bit linkage pointer onto the program D9A8| ; stack (the linkage pointer is 0 if no other string D9A8| ; or packed array has yet been pushed onto the D9A8| ; stack); push a pointer onto the evaluation stack D9A8| ; that points to the first byte of the packed array D9A8| ; on the program stack. If the same packed array has D9A8| ; been pushed onto the stack during the currently D9A8| ; active procedure, push a pointer onto the evaluation D9A8| ; stack that points to the first byte of the array D9A8| ; on the program stack. The contents of the program D9A8| ; stack are not changed. In either case, advance D9A8| ; the IPC register past the original copy of the D9A8| ; array in the code space. D9A8| ;--------------------------------------------------- D9A8| 20 78D9 LPA JSR FIND_S ; Find string. D9AB| A5 58 LDA IPC D9AD| 85 80 STA Z80 D9AF| A5 59 LDA IPC+1 D9B1| 85 81 STA Z80+1 D9B3| E6 58 INC IPC D9B5| D0** BNE $01 D9B7| E6 59 INC IPC+1 D9B9| 8D 03C0 $01 STA RDCARDRAM ; Set up to read p-code RAM. D9BC| A0 00 LDY #0 D9BE| B1 58 LDA @IPC,Y D9C0| 8D 02C0 STA RDMAINRAM ; Restore reads to main RAM. D9C3| 85 82 STA Z82 D9C5| E6 58 INC IPC D9C7| D0** BNE $02 D9C9| E6 59 INC IPC+1 D9CB| 4C **** $02 JMP LSA_1 D9CE| D9CE| D9CE| ;--------------------------------------------------- D9CE| ; LOAD CONSTANT STRING ADDRESS: LSA UB, D9CE| ; Push a word pointer to the constant character D9CE| ; string UB, onto the evaluation stack. As D9CE| ; the constant string is contained in the code D9CE| ; segment (not stack/heap), a copy of the string is D9CE| ; pushed onto the program stack. If this string has D9CE| ; not previously been pushed onto the stack during D9CE| ; the currently active procedure, copy UB D9CE| ; onto the program stack (add one space at the end D9CE| ; of the string if UB is an even number of D9CE| ; characters); push a 16-bit integer onto the program D9CE| ; stack that points to the first byte of the string D9CE| ; in the procedure code; push a 16-bit linkage D9CE| ; pointer onto the program stack that points to the D9CE| ; string or packed array most recently pushed onto D9CE| ; the program stack (the linkage pointer is 0 if no D9CE| ; other string or packed array has yet been pushed D9CE| ; onto the stack); push a pointer onto the evaluation D9CE| ; stack that points to the string length byte UB on D9CE| ; the program stack. If UB has been pushed D9CE| ; onto the stack during the current procedure, push D9CE| ; a pointer onto the evaluation stack that points to D9CE| ; the string length byte UB on the program stack. D9CE| ; The contents of the program stack are not changed. D9CE| ; In either case, advance the IPC register past the D9CE| ; original copy of the string in the code space. D9CE| ;--------------------------------------------------- D9CE| 20 78D9 LSA JSR FIND_S ; Find string. D9D1| A5 58 LDA IPC D9D3| 85 80 STA Z80 D9D5| A5 59 LDA IPC+1 D9D7| 85 81 STA Z80+1 D9D9| E6 58 INC IPC D9DB| D0** BNE $01 D9DD| E6 59 INC IPC+1 D9DF| 8D 03C0 $01 STA RDCARDRAM ; Set up to read p-code RAM. D9E2| A0 00 LDY #0 D9E4| B1 58 LDA @IPC,Y D9E6| 8D 02C0 STA RDMAINRAM ; Restore reads to main RAM. D9E9| 85 82 STA Z82 D9EB| E6 82 INC Z82 D9ED| D9ED| ; Jump address from LPA D9ED| A5 7F LSA_1 LDA Z7E+1 D9EF| D0** BNE $09 D9F1| A5 7E LDA Z7E D9F3| D0** BNE $09 D9F5| D9F5| A5 5C LDA KP D9F7| 38 SEC D9F8| E5 82 SBC Z82 D9FA| 85 5C STA KP D9FC| B0** BCS $03 D9FE| C6 5D DEC KP+1 DA00| A5 5C $03 LDA KP DA02| 29 FE AND #0FE DA04| 85 5C STA KP DA06| A5 5D LDA KP+1 DA08| 48 PHA DA09| A5 5C LDA KP DA0B| 48 PHA DA0C| A4 82 LDY Z82 DA0E| 88 DEY DA0F| 30** BMI $05 DA11| DA11| 8D 03C0 STA RDCARDRAM ; Set up to read p-code RAM. DA14| B1 58 $04 LDA @IPC,Y DA16| 91 5C STA @KP,Y DA18| 88 DEY DA19| 10F9 BPL $04 DA1B| 8D 02C0 STA RDMAINRAM ; Restore reads to main RAM. DA1E| DA1E| A5 5C $05 LDA KP DA20| 38 SEC DA21| E9 04 SBC #4 DA23| 85 5C STA KP DA25| B0** BCS $06 DA27| C6 5D DEC KP+1 DA29| DA29| A0 00 $06 LDY #0 DA2B| A5 80 LDA Z80 DA2D| 91 5C STA @KP,Y DA2F| C8 INY DA30| A5 81 LDA Z80+1 DA32| 91 5C STA @KP,Y DA34| C8 INY DA35| A5 5E LDA STRP DA37| 91 5C STA @KP,Y DA39| C8 INY DA3A| A5 5F LDA STRP+1 DA3C| 91 5C STA @KP,Y DA3E| A5 5C LDA KP DA40| 85 5E STA STRP DA42| A5 5D LDA KP+1 DA44| 85 5F STA STRP+1 DA46| 38 SEC DA47| A5 5C LDA KP DA49| E5 5A SBC NP DA4B| A5 5D LDA KP+1 DA4D| E5 5B SBC NP+1 DA4F| B0** BCS $07 DA51| 4C EDD1 JMP STKOVFL DA54| DA54| A5 58 $07 LDA IPC DA56| 18 CLC DA57| 65 82 ADC Z82 DA59| 85 58 STA IPC DA5B| 90** BCC $08 DA5D| E6 59 INC IPC+1 DA5F| 4C B4D2 $08 JMP MAINLOOP DA62| DA62| A5 7E $09 LDA Z7E DA64| 18 CLC DA65| 69 04 ADC #4 DA67| 85 7E STA Z7E DA69| 90** BCC $10 DA6B| E6 7F INC Z7E+1 DA6D| A5 7F $10 LDA Z7E+1 DA6F| 48 PHA DA70| A5 7E LDA Z7E DA72| 48 PHA DA73| 4C 54DA JMP $07 DA76| DA76| DA76| DA76| DA76| ;================================================================= DA76| DA76| .INCLUDE LOC1.3:INTERP1.3C.TEXT DA76| ;--------------------------------------------------- DA76| ; STRING ASSIGN: SAS UB DA76| ; tos is eigher a source byte pointer or a single DA76| ; character. (Chars always have high byte = 0 while DA76| ; pointers never do.) tos-1 is a destination byte DA76| ; pointer. UB is the declared size of the destination DA76| ; string. If the declared size is less than the DA76| ; current size of the source string, give an exec DA76| ; error; otherwise transfer all bytes of the source DA76| ; containing valid information to the destination. DA76| ;--------------------------------------------------- DA76| ; SAS (string assign) p-code: On the top of stack DA76| ; are two words. The 1st is either a pointer to a DA76| ; source string or a single character. (If the high DA76| ; order byte is zero, it is a single character.) The DA76| ; word at TOS-1 is a pointer to a destination string. DA76| ; If TOS is a single character then the value 1 is DA76| ; stored at the address pointed at by TOS-1 and the DA76| ; character is stored in the next consecutive byte. DA76| ; If a string pointer is on TOS, the length of that DA76| ; string (pointed at by the pointer) is compared to DA76| ; the UB value that follows the SAS opcode. If the DA76| ; length of the string is > this UB value, a run-time DA76| ; bounds error occurs. Otherwise, the string pointed DA76| ; to by TOS is stored into the string pointed at by DA76| ; TOS-1. IPC is incremented by 2 and control is DA76| ; transferred to the main loop. DA76| ;--------------------------------------------------- DA76| 68 SAS PLA DA77| 85 72 STA SOURCE DA79| 68 PLA DA7A| 85 73 STA SOURCE+1 DA7C| 68 PLA DA7D| 85 74 STA DEST DA7F| 68 PLA DA80| 85 75 STA DEST+1 DA82| 8D 03C0 STA RDCARDRAM ; Set up to read p-code RAM. DA85| A0 01 LDY #1 DA87| B1 58 LDA @IPC,Y DA89| 8D 02C0 STA RDMAINRAM ; Restore reads to main RAM. DA8C| A6 73 LDX SOURCE+1 DA8E| D0** BNE $01 DA90| DA90| C9 01 CMP #1 DA92| 90** BCC $04 ; String overflow error! DA94| DA94| A9 01 LDA #1 DA96| A0 00 LDY #0 DA98| 91 74 STA @DEST,Y DA9A| A5 72 LDA SOURCE DA9C| C8 INY DA9D| 91 74 STA @DEST,Y DA9F| 4C 88D2 JMP UPIPC2 DAA2| DAA2| A0 00 $01 LDY #0 DAA4| D1 72 CMP @SOURCE,Y DAA6| 90** BCC $04 ; String overflow error! DAA8| B1 72 LDA @SOURCE,Y DAAA| 91 74 STA @DEST,Y DAAC| A8 TAY DAAD| 4C **** JMP $03 DAB0| DAB0| B1 72 $02 LDA @SOURCE,Y DAB2| 91 74 STA @DEST,Y DAB4| 88 DEY DAB5| D0F9 $03 BNE $02 DAB7| 4C 88D2 JMP UPIPC2 DABA| DABA| 4C 2DD2 $04 JMP STROVFL DABD| DABD| DABD| ;--------------------------------------------------- DABD| ; INDEX STRING ARRAY: IXS DABD| ; tos-1 is a byte pointer to a string. tos is an DABD| ; index into the string. Check to see that the index DABD| ; is in the range 1..current string length. If so, DABD| ; continue execution; if not, give an exec error. DABD| ;--------------------------------------------------- DABD| ; IXS (index string array) p-code: TOS contains an DABD| ; index into a string array. TOS-1 is a pointer to DABD| ; a string. If TOS is outside 1..255, an execution DABD| ; error occurs. Otherwise return to the main loop, DABD| ; leaving TOS and TOS-1 on the stack. DABD| ;--------------------------------------------------- DABD| BA IXS TSX DABE| BD 0201 LDA STACK+2,X DAC1| D0** BNE $01 ; Range error! DAC3| BD 0101 LDA STACK+1,X DAC6| F0** BEQ $01 ; Range error! DAC8| BC 0301 LDY STACK+3,X DACB| 84 7E STY Z7E DACD| BC 0401 LDY STACK+4,X DAD0| 84 7F STY Z7E+1 DAD2| A0 00 LDY #0 DAD4| D1 7E CMP @Z7E,Y DAD6| 90** BCC $02 DAD8| F0** BEQ $02 DADA| DADA| 4C E1D1 $01 JMP RNGERR ; Range error! DADD| DADD| 4C AED2 $02 JMP UPIPC1 DAE0| DAE0| DAE0| ;--------------------------------------------------- DAE0| ; STATIC INDEX AND LOAD WORD: IND B DAE0| ; Index the word pointer tos by B words, and push DAE0| ; the word pointed to by the result. DAE0| ;--------------------------------------------------- DAE0| ; IND (static index and load word) p-code: TOS is a DAE0| ; pointer to a word structure. It is popped and DAE0| ; added to the BIG parameter that follows the IND DAE0| ; opcode. The word pointed at by this sum is pushed DAE0| ; onto the stack. DAE0| ;--------------------------------------------------- DAE0| A0 01 IND LDY #1 DAE2| 20 55D1 JSR GETBIG DAE5| 18 CLC DAE6| 68 PLA DAE7| 65 68 ADC BIG DAE9| 85 82 STA Z82 DAEB| 68 PLA DAEC| 65 69 ADC BIG+1 DAEE| 85 83 STA Z82+1 DAF0| A0 01 LDY #1 DAF2| B1 82 LDA @Z82,Y DAF4| 48 PHA DAF5| 88 DEY DAF6| B1 82 LDA @Z82,Y DAF8| 48 PHA DAF9| 4C 88D2 JMP UPIPC2 DAFC| DAFC| DAFC| ;--------------------------------------------------- DAFC| ; INCREMENT FIELD POINTER: INC B DAFC| ; Index the word pointer tos by B words and push DAFC| ; the resultant word pointer. DAFC| ;--------------------------------------------------- DAFC| ; INC (increment field pointer) p-code: The word on DAFC| ; TOS is popped, added to the BIG parameter that DAFC| ; follows the opcode, and the sum is pushed. DAFC| ;--------------------------------------------------- DAFC| A0 01 P_INC LDY #1 DAFE| 20 55D1 JSR GETBIG DB01| 18 CLC DB02| 68 PLA DB03| 65 68 ADC BIG DB05| AA TAX DB06| 68 PLA DB07| 65 69 ADC BIG+1 DB09| 48 PHA DB0A| 8A TXA DB0B| 48 PHA DB0C| 4C 88D2 JMP UPIPC2 DB0F| DB0F| DB0F| ;--------------------------------------------------- DB0F| ; INDEX ARRAY: IXA B DB0F| ; tos is an integer index, tos-1 is the array base DB0F| ; word pointer, and B is the size (in words) of an DB0F| ; array element. Comopute a word pointer (tos-1)+ DB0F| ; (B*tos) to the indexed element and push the ptr. DB0F| ;--------------------------------------------------- DB0F| ; IXA (index array) p-code: TOS is an integer index DB0F| ; into an array whose base element is at TOS-1. A DB0F| ; BIG parameter is fetched from the code stream DB0F| ; (the size of each element of the array). This DB0F| ; value is checked to see if it is two. If so, the DB0F| ; value on TOS is multiplied by two and then added DB0F| ; to the base address. If the BIG value is not two, DB0F| ; the value on TOS is multiplied by BIG and the DB0F| ; product is added to the base address. The sum is DB0F| ; left on TOS. DB0F| ;--------------------------------------------------- DB0F| 68 IXA PLA DB10| 85 92 STA Z92 DB12| 68 PLA DB13| 85 93 STA Z92+1 DB15| A0 01 LDY #1 DB17| 20 55D1 JSR GETBIG DB1A| A5 69 LDA BIG+1 DB1C| D0** BNE $01 DB1E| DB1E| A5 68 LDA BIG DB20| C9 02 CMP #2 DB22| D0** BNE $01 DB24| DB24| 06 92 ASL Z92 DB26| 26 93 ROL Z92+1 DB28| 4C **** JMP $02 DB2B| DB2B| A5 68 $01 LDA BIG DB2D| 85 94 STA Z94 DB2F| A5 69 LDA BIG+1 DB31| 85 95 STA Z94+1 DB33| 20 C6D7 JSR MULTIPLY DB36| A5 96 LDA Z96 DB38| 85 92 STA Z92 DB3A| A5 97 LDA Z96+1 DB3C| 85 93 STA Z92+1 DB3E| DB3E| 18 $02 CLC DB3F| 68 PLA DB40| 65 92 ADC Z92 DB42| 85 82 STA Z82 DB44| 68 PLA DB45| 65 93 ADC Z92+1 DB47| 48 PHA DB48| A5 82 LDA Z82 DB4A| 48 PHA DB4B| 4C 88D2 JMP UPIPC2 DB4E| DB4E| DB4E| ;--------------------------------------------------- DB4E| ; INDEX PACKED ARRAY: IXP UB1,UB2 DB4E| ; tos is an integer index, tos-1 is the array base DB4E| ; word pointer. UP1 is the number of elements per DB4E| ; word, and UB2 is the field width (in bits). Compute DB4E| ; a packed field pointer to the indexed field and DB4E| ; push the resulting pointer. DB4E| ;--------------------------------------------------- DB4E| ; IXP (index packed array) p-code: The opcode is DB4E| ; followed by two unsigned byte parameters and there DB4E| ; are two words of parameters on TOS. TOS is an DB4E| ; integer and TOS-1 is the array base pointer. To DB4E| ; begin with, the two UB values are fetched from the DB4E| ; code stream and saved on zero page. The high order DB4E| ; bytes for these values are then zeroed. Next the DB4E| ; integer index is popped off the stack and saved DB4E| ; in a pair of zero page locations. Then DVIMOD is DB4E| ; called to compute "index DIV UB1" and "index MOD DB4E| ; UB1". The quotient is shifted to the left to DB4E| ; convert it from a word index to a byte index. DB4E| ; This byte offset is added to the array base DB4E| ; address (which is popped off the stack). This sum DB4E| ; points at the byte containing the bit field we DB4E| ; are interested in. This byte pointer is pushed DB4E| ; onto the stack. Next the field width, which is DB4E| ; the value "index MOD UB1" is pushed onto the DB4E| ; stack. Finally the right bit number (computed by DB4E| ; rbn := UB2*(index mod UB1)) is pushed. DB4E| ;--------------------------------------------------- DB4E| 8D 03C0 IXP STA RDCARDRAM ; Set up to read p-code RAM. DB51| A0 01 LDY #1 DB53| B1 58 LDA @IPC,Y DB55| 8D 02C0 STA RDMAINRAM ; Restore reads to main RAM. DB58| 85 90 STA Z90 DB5A| 8D 03C0 STA RDCARDRAM ; Set up to read p-code RAM. DB5D| A0 02 LDY #2 DB5F| B1 58 LDA @IPC,Y DB61| 8D 02C0 STA RDMAINRAM ; Restore reads to main RAM. DB64| 85 84 STA Z84 DB66| A9 00 LDA #0 DB68| 85 91 STA Z90+1 DB6A| 85 85 STA Z84+1 DB6C| 68 PLA DB6D| 85 92 STA Z92 DB6F| 68 PLA DB70| 85 93 STA Z92+1 DB72| 20 40D8 JSR DVIMOD DB75| 06 96 ASL Z96 DB77| 26 97 ROL Z96+1 DB79| 18 CLC DB7A| 68 PLA DB7B| 65 96 ADC Z96 DB7D| 85 82 STA Z82 DB7F| 68 PLA DB80| 65 97 ADC Z96+1 DB82| 48 PHA DB83| A5 82 LDA Z82 DB85| 48 PHA DB86| A5 85 LDA Z84+1 DB88| 48 PHA DB89| A5 84 LDA Z84 DB8B| 48 PHA DB8C| A9 00 LDA #0 DB8E| A6 92 LDX Z92 DB90| F0** BEQ $02 DB92| DB92| 18 CLC DB93| 65 84 $01 ADC Z84 DB95| CA DEX DB96| D0FB BNE $01 DB98| DB98| 48 $02 PHA DB99| 48 PHA DB9A| 4C 7BD2 JMP UPIPC3 DB9D| DB9D| DB9D| ;--------------------------------------------------- DB9D| ; LOAD A PACKED FIELD: LDP DB9D| ; Fetch the field indicated by the packed field DB9D| ; pointer tos, and push it. DB9D| ;--------------------------------------------------- DB9D| ; LDP (load packed field) p-code: LDP expects a three DB9D| ; byte packed field pointer on TOS. The byte on TOS DB9D| ; is the right bit number, TOS-1 is the field width, DB9D| ; and the byte at TOS-2 is a pointer to the byte DB9D| ; where the structure is located. These three bits DB9D| ; are popped and stored into zero page. The word DB9D| ; pointed at by the pointer is loded into $7E/7F. DB9D| ; If the right bit number is > 8, location $7F is DB9D| ; stored into $7E and 8 is subtracted from the DB9D| ; right abit number. Next, the bits in location DB9D| ; $7E/7F are shifted to the right the indicated DB9D| ; number of times, right justifying the field. DB9D| ; Finally, the field width is multiplied by two and DB9D| ; used as an index into a table of two-byte masks. DB9D| ; Locations $7E/7F are ANDed with these two DB9D| ; masks (to turn off unnecessary high order bits). DB9D| ; The result is pushed onto the evaluation stack. DB9D| ;--------------------------------------------------- DB9D| 68 LDP PLA DB9E| 85 86 STA Z86 DBA0| 68 PLA DBA1| 85 87 STA Z86+1 DBA3| 68 PLA DBA4| 85 84 STA Z84 DBA6| 68 PLA DBA7| 85 85 STA Z84+1 DBA9| 68 PLA DBAA| 85 82 STA Z82 DBAC| 68 PLA DBAD| 85 83 STA Z82+1 DBAF| A0 00 LDY #0 DBB1| B1 82 LDA @Z82,Y DBB3| 85 88 STA Z88 DBB5| C8 INY DBB6| B1 82 LDA @Z82,Y DBB8| 85 89 STA Z88+1 DBBA| A5 86 LDA Z86 DBBC| 38 SEC DBBD| E9 08 SBC #8 DBBF| 30** BMI $01 DBC1| DBC1| AA TAX DBC2| A5 88 LDA Z88 DBC4| A4 89 LDY Z88+1 DBC6| 84 88 STY Z88 DBC8| 85 89 STA Z88+1 DBCA| E0 00 CPX #0 DBCC| D0** BNE $02 DBCE| F0** BEQ $03 DBD0| DBD0| 69 08 $01 ADC #8 DBD2| AA TAX DBD3| F0** BEQ $03 DBD5| DBD5| 66 89 $02 ROR Z88+1 DBD7| 66 88 ROR Z88 DBD9| CA DEX DBDA| D0F9 BNE $02 DBDC| DBDC| A5 84 $03 LDA Z84 DBDE| 0A ASL A DBDF| AA TAX DBE0| A5 88 LDA Z88 DBE2| 3D **** AND LDF19,X DBE5| 85 88 STA Z88 DBE7| A5 89 LDA Z88+1 DBE9| 3D **** AND LDF1A,X DBEC| 48 PHA DBED| A5 88 LDA Z88 DBEF| 48 PHA DBF0| 4C AED2 JMP UPIPC1 DBF3| DBF3| DBF3| ;--------------------------------------------------- DBF3| ; STORE INTO A PACKED FIELD: STP DBF3| ; Store the data tos into the field indicated by DBF3| ; the packed field pointer tos-1. DBF3| ;--------------------------------------------------- DBF3| ; STP (store into a packed field) p-code: Pops the DBF3| ; word off TOS and stores it into the packed field DBF3| ; pointer which occupies the three words of storage DBF3| ; immediately below the data on the stack. The DBF3| ; routine begins by popping the data, right bit DBF3| ; number, and field widgh pointer off of the stack. DBF3| ; The data is then masked so that only the pertinent DBF3| ; bits are retained. Next, the data is shifted to DBF3| ; properly align it. Then a pointer to the word DBF3| ; structure where this data is to be stored is DBF3| ; popped off the stack and the two words pointed DBF3| ; at by this pointer are fetched. The bit positions DBF3| ; where the data is to be stored is zeroed out and DBF3| ; the data is ORed into this spot. Finally, the DBF3| ; data is stored back into the memory word described DBF3| ; by the pointer popped off of the stack. DBF3| ;--------------------------------------------------- DBF3| 68 STP PLA DBF4| 85 7E STA Z7E DBF6| 68 PLA DBF7| 85 7F STA Z7E+1 DBF9| 68 PLA DBFA| 85 86 STA Z86 DBFC| 68 PLA DBFD| 85 87 STA Z86+1 DBFF| 68 PLA DC00| 85 84 STA Z84 DC02| 68 PLA DC03| 85 85 STA Z84+1 DC05| A5 84 LDA Z84 DC07| 0A ASL A DC08| AA TAX DC09| BD **** LDA LDF19,X DC0C| 85 80 STA Z80 DC0E| 25 7E AND Z7E DC10| 85 7E STA Z7E DC12| BD **** LDA LDF1A,X DC15| 85 81 STA Z80+1 DC17| 25 7F AND Z7E+1 DC19| 85 7F STA Z7E+1 DC1B| A5 86 LDA Z86 DC1D| 38 SEC DC1E| E9 08 SBC #8 DC20| 30** BMI $01 DC22| DC22| AA TAX DC23| A5 7E LDA Z7E DC25| A4 7F LDY Z7E+1 DC27| 85 7F STA Z7E+1 DC29| 84 7E STY Z7E DC2B| A5 80 LDA Z80 DC2D| A4 81 LDY Z80+1 DC2F| 85 81 STA Z80+1 DC31| 84 80 STY Z80 DC33| E0 00 CPX #0 DC35| D0** BNE $02 DC37| F0** BEQ $03 DC39| DC39| 69 08 $01 ADC #8 DC3B| AA TAX DC3C| F0** BEQ $03 DC3E| DC3E| 06 7E $02 ASL Z7E DC40| 26 7F ROL Z7E+1 DC42| 06 80 ASL Z80 DC44| 26 81 ROL Z80+1 DC46| CA DEX DC47| D0F5 BNE $02 DC49| DC49| 68 $03 PLA DC4A| 85 82 STA Z82 DC4C| 68 PLA DC4D| 85 83 STA Z82+1 DC4F| A0 00 LDY #0 DC51| B1 82 LDA @Z82,Y DC53| 85 88 STA Z88 DC55| C8 INY DC56| B1 82 LDA @Z82,Y DC58| 85 89 STA Z88+1 DC5A| A5 80 LDA Z80 DC5C| 49 FF EOR #0FF DC5E| 25 88 AND Z88 DC60| 05 7E ORA Z7E DC62| 85 88 STA Z88 DC64| A5 81 LDA Z80+1 DC66| 49 FF EOR #0FF DC68| 25 89 AND Z88+1 DC6A| 05 7F ORA Z7E+1 DC6C| 85 89 STA Z88+1 DC6E| A0 00 LDY #0 DC70| A5 88 LDA Z88 DC72| 91 82 STA @Z82,Y DC74| C8 INY DC75| A5 89 LDA Z88+1 DC77| 91 82 STA @Z82,Y DC79| 4C AED2 JMP UPIPC1 DC7C| DC7C| .PAGE DC7C| ;--------------------------------------------------- DC7C| ; FIXSET subroutine: Most of the stack operations DC7C| ; expect two sets to appear on top of the stack: DC7C| ; {beginning at TOS, working down} DC7C| ; Size B (in words) <--SP DC7C| ; Set B DC7C| ; Size A (in words) DC7C| ; Set A DC7C| ; FIXSET gets the two sizes and sets up pointers DC7C| ; to the two sets (on page 1) DC7C| ;--------------------------------------------------- DC7C| 68 FIXSET PLA DC7D| 85 96 STA Z96 DC7F| 68 PLA DC80| 85 97 STA Z96+1 DC82| 68 PLA DC83| 0A ASL A DC84| 85 86 STA Z86 DC86| 68 PLA DC87| BA TSX DC88| 8A TXA DC89| 18 CLC DC8A| 65 86 ADC Z86 DC8C| A8 TAY DC8D| C8 INY DC8E| 84 88 STY Z88 DC90| B9 0001 LDA STACK,Y DC93| 0A ASL A DC94| C8 INY DC95| C8 INY DC96| 84 7E STY Z7E DC98| E6 96 INC Z96 DC9A| D0** BNE $01 DC9C| E6 97 INC Z96+1 DC9E| 6C 9600 $01 JMP @Z96 DCA1| DCA1| DCA1| ;--------------------------------------------------- DCA1| ; SET INTERSECTION: INT DCA1| ; Push the intersection of sets tos and tos-1. DCA1| ; (tos AND tos-1) DCA1| ;--------------------------------------------------- DCA1| ; INT (set intersection) p-code: The intersection is DCA1| ; performed by ANDing set B with set A. If the sets DCA1| ; are not the same size, the high order 'n' words of DCA1| ; the resultant set are zero. This routine ANDs the DCA1| ; low order bytes of A with the low order bytes of DCA1| ; B and stores the result back into A until 'n' DCA1| ; words have been ANDed together (where 'n' is the DCA1| ; minimum of size A and size B). Finally, 'm' words DCA1| ; of zero are pushed, where 'm' is the absolute DCA1| ; value of the difference between size A and size B. DCA1| ; Finally, the 6502 stack pointer is moved so it DCA1| ; points to the new set just created. DCA1| ;--------------------------------------------------- DCA1| 20 7CDC INT JSR FIXSET DCA4| A6 86 LDX Z86 DCA6| 38 SEC DCA7| E5 86 SBC Z86 DCA9| 10** BPL $01 DCAB| DCAB| 18 CLC DCAC| 65 86 ADC Z86 DCAE| AA TAX DCAF| A9 00 LDA #0 DCB1| 85 9A $01 STA Z9A DCB3| E0 00 CPX #0 DCB5| F0** BEQ $03 DCB7| DCB7| 68 $02 PLA DCB8| 39 0001 AND STACK,Y DCBB| 99 0001 STA STACK,Y DCBE| C8 INY DCBF| CA DEX DCC0| D0F5 BNE $02 DCC2| DCC2| A6 9A $03 LDX Z9A DCC4| F0** BEQ $05 DCC6| 30** BMI $05 DCC8| DCC8| A9 00 LDA #0 DCCA| 99 0001 $04 STA STACK,Y DCCD| C8 INY DCCE| CA DEX DCCF| D0F9 BNE $04 DCD1| DCD1| A6 88 $05 LDX Z88 DCD3| CA DEX DCD4| 9A TXS DCD5| 4C AED2 JMP UPIPC1 DCD8| DCD8| DCD8| ;--------------------------------------------------- DCD8| ; SET DIFFERENCE: DIF DCD8| ; Push the difference of sets tos-1 and tos. DCD8| ; (tos-1 AND NOT tos). DCD8| ;--------------------------------------------------- DCD8| ; DIF (set difference) p-code: Logically negates set DCD8| ; B and then ANDs it into set A. The X-reg is loaded DCD8| ; with the min(size B, size A) and then this many DCD8| ; bytes are taken from set B, inverted, and ANDed DCD8| ; with the corresponding byte in set A. If there are DCD8| ; more entries in set A than set B, the high order DCD8| ; entries are left untouched. Finally, the SP register DCD8| ; is loaded with the pointer to set A. DCD8| ;--------------------------------------------------- DCD8| 20 7CDC DIF JSR FIXSET DCDB| A6 86 LDX Z86 DCDD| C5 86 CMP Z86 DCDF| 10** BPL $01 DCE1| DCE1| AA TAX DCE2| E0 00 $01 CPX #0 DCE4| F0** BEQ $03 DCE6| DCE6| 68 $02 PLA DCE7| 49 FF EOR #0FF DCE9| 39 0001 AND STACK,Y DCEC| 99 0001 STA STACK,Y DCEF| C8 INY DCF0| CA DEX DCF1| D0F3 BNE $02 DCF3| DCF3| A6 88 $03 LDX Z88 DCF5| CA DEX DCF6| 9A TXS DCF7| 4C AED2 JMP UPIPC1 DCFA| DCFA| DCFA| ;--------------------------------------------------- DCFA| ; SET UNION: UNI DCFA| ; Push the union of sets tos and tos-1. DCFA| ; (tos OR tos-1) DCFA| ;--------------------------------------------------- DCFA| ; UNI (set union) p-code: Compares the size of A with DCFA| ; the size of B. If size A >= size B, a short routine DCFA| ; is executed which pops the B set off the stack and DCFA| ; ORs it with the A set. If size A < size B, a DCFA| ; separate routine is called that ORs set A into set DCFA| ; B, then moves set B down over set A on the stack. DCFA| ; If the size of B is zero, then A is simply returned. DCFA| ;--------------------------------------------------- DCFA| 20 7CDC UNI JSR FIXSET DCFD| C5 86 CMP Z86 DCFF| 30** BMI $03 DD01| DD01| A6 86 LDX Z86 DD03| E0 00 CPX #0 DD05| F0** BEQ $02 DD07| DD07| 68 $01 PLA DD08| 19 0001 ORA STACK,Y DD0B| 99 0001 STA STACK,Y DD0E| C8 INY DD0F| CA DEX DD10| D0F5 BNE $01 DD12| DD12| A6 88 $02 LDX Z88 DD14| CA DEX DD15| 9A TXS DD16| 4C AED2 JMP UPIPC1 DD19| DD19| DD19| 85 84 $03 STA Z84 DD1B| C9 00 CMP #0 DD1D| D0** BNE $04 DD1F| F0** BEQ $06 DD21| DD21| BA $04 TSX DD22| E8 INX DD23| A4 7E LDY Z7E DD25| A5 84 LDA Z84 DD27| 85 82 STA Z82 DD29| A5 85 LDA Z84+1 DD2B| 85 83 STA Z82+1 DD2D| B9 0001 $05 LDA STACK,Y DD30| 1D 0001 ORA STACK,X DD33| 9D 0001 STA STACK,X DD36| C8 INY DD37| E8 INX DD38| C6 82 DEC Z82 DD3A| D0F1 BNE $05 DD3C| DD3C| A5 7E $06 LDA Z7E DD3E| 18 CLC DD3F| 65 84 ADC Z84 DD41| AA TAX DD42| CA DEX DD43| A5 86 LDA Z86 DD45| 85 82 STA Z82 DD47| A5 87 LDA Z86+1 DD49| 85 83 STA Z82+1 DD4B| A4 88 LDY Z88 DD4D| 88 DEY DD4E| B9 0001 $07 LDA STACK,Y DD51| 9D 0001 STA STACK,X DD54| 88 DEY DD55| CA DEX DD56| C6 82 DEC Z82 DD58| D0F4 BNE $07 DD5A| DD5A| 9A TXS DD5B| 46 86 LSR Z86 DD5D| A5 87 LDA Z86+1 DD5F| 48 PHA DD60| A5 86 LDA Z86 DD62| 48 PHA DD63| 4C AED2 JMP UPIPC1 DD66| DD66| DD66| ;--------------------------------------------------- DD66| ; ADJUST SET: ADJ UB DD66| ; Force the set tos to occupy UB words, either by DD66| ; expansion (pushing zeroes "between" tos and tos-1) DD66| ; or by compression (chopping high words off the DD66| ; set), discard the length word, and push the DD66| ; resulting set. DD66| ;--------------------------------------------------- DD66| ; ADJ (set adjust) p-code: A single UB parameter is DD66| ; fetched from the code stream. This byte contains DD66| ; the final size (in words) that the set on TOS DD66| ; must occupy. If the size of the set = this value, DD66| ; control returns to the main loop. If the set size DD66| ; > this value, UB words on TOS are moved down over DD66| ; the extra words which are to be truncated: First, DD66| ; the Y-reg is loaded with a pointer to the last DD66| ; (high order) byte of the set which is to be kept. DD66| ; Next the X-reg is loaded with a pointer to the DD66| ; high order byte of the current set. Finally, the DD66| ; UB bytes pointed at by Y are transferred down to DD66| ; the set pointed at by X-reg and control is DD66| ; returned to the main interpreter loop. If the DD66| ; size of the set on TOS > UB: The size of the set DD66| ; on TOS is checked to see if = 0. If so, the SP DD66| ; register is modified accordingly and control is DD66| ; transferred to the zero fill loop. If the size DD66| ; of the set <> 0, it is moved downwards in memory DD66| ; in order to expand the size of the set. In either DD66| ; case, control returns to the main loop. DD66| ;--------------------------------------------------- DD66| 8D 03C0 ADJ STA RDCARDRAM ; Read from p-code RAM. DD69| A0 01 LDY #1 DD6B| B1 58 LDA @IPC,Y DD6D| 8D 02C0 STA RDMAINRAM ; Read from main RAM again. DD70| 0A ASL A DD71| 85 8E STA Z8E DD73| 68 PLA DD74| 85 8C STA Z8C DD76| 68 PLA DD77| 85 8D STA Z8C+1 DD79| 06 8C ASL Z8C DD7B| 26 8D ROL Z8C+1 DD7D| A5 8C LDA Z8C DD7F| C5 8E CMP Z8E DD81| D0** BNE $01 DD83| 4C 88D2 JMP UPIPC2 DD86| DD86| 30** $01 BMI $03 DD88| BA TSX DD89| 8A TXA DD8A| 18 CLC DD8B| 65 8E ADC Z8E DD8D| A8 TAY DD8E| 8A TXA DD8F| 18 CLC DD90| 65 8C ADC Z8C DD92| AA TAX DD93| B9 0001 $02 LDA STACK,Y DD96| 9D 0001 STA STACK,X DD99| 88 DEY DD9A| CA DEX DD9B| C6 8E DEC Z8E DD9D| D0F4 BNE $02 DD9F| DD9F| 9A TXS DDA0| 4C 88D2 JMP UPIPC2 DDA3| DDA3| DDA3| A5 8E $03 LDA Z8E DDA5| 38 SEC DDA6| E5 8C SBC Z8C DDA8| 85 90 STA Z90 DDAA| C5 8E CMP Z8E DDAC| D0** BNE $04 DDAE| DDAE| BA TSX DDAF| 8A TXA DDB0| 38 SEC DDB1| E5 90 SBC Z90 DDB3| AA TAX DDB4| 9A TXS DDB5| E8 INX DDB6| D0** BNE $06 DDB8| DDB8| BA $04 TSX DDB9| 8A TXA DDBA| A8 TAY DDBB| C8 INY DDBC| 38 SEC DDBD| E5 90 SBC Z90 DDBF| AA TAX DDC0| 9A TXS DDC1| E8 INX DDC2| B9 0001 $05 LDA STACK,Y DDC5| 9D 0001 STA STACK,X DDC8| C8 INY DDC9| E8 INX DDCA| C6 8C DEC Z8C DDCC| D0F4 BNE $05 DDCE| DDCE| A4 90 $06 LDY Z90 DDD0| A9 00 LDA #0 DDD2| 9D 0001 $07 STA STACK,X DDD5| E8 INX DDD6| 88 DEY DDD7| D0F9 BNE $07 DDD9| DDD9| 4C 88D2 JMP UPIPC2 DDDC| DDDC| DDDC| ;--------------------------------------------------- DDDC| ; SET MEMBERSHIP: INN DDDC| ; If integer tos-1 is in set tos, push TRUE. If not, DDDC| ; push FALSE. DDDC| ;--------------------------------------------------- DDDC| ; INN (set inclusion) p-code: Expects the following DDDC| ; on TOS: Size A <--SP DDDC| ; Set A DDDC| ; I DDDC| ; where size A is the size of the set A which DDDC| ; immediately follows on the stack, and I is an DDDC| ; integer. I is divided by 8 (shifted) and I MOD 8 DDDC| ; (by ANDing) is also saved. The value I DIV 8 is DDDC| ; used as an index into the set and the I MOD 8 DDDC| ; bit of this byte is checked. If this bit = 1, DDDC| ; TRUE is pushed onto the stack. DDDC| ;--------------------------------------------------- DDDC| 68 INN PLA DDDD| 85 8C STA Z8C DDDF| 68 PLA DDE0| 85 8D STA Z8C+1 DDE2| 06 8C ASL Z8C DDE4| 26 8D ROL Z8C+1 DDE6| BA TSX DDE7| 8A TXA DDE8| 18 CLC DDE9| 65 8C ADC Z8C DDEB| A8 TAY DDEC| C8 INY DDED| B9 0001 LDA STACK,Y DDF0| 85 86 STA Z86 DDF2| C8 INY DDF3| B9 0001 LDA STACK,Y DDF6| 85 87 STA Z86+1 DDF8| 84 70 STY Z70 DDFA| 29 FE AND #0FE DDFC| D0** BNE $01 DDFE| DDFE| A5 86 LDA Z86 DE00| 29 07 AND #7 DE02| 85 7F STA Z7E+1 DE04| 66 87 ROR Z86+1 DE06| A5 86 LDA Z86 DE08| 6A ROR A DE09| 6A ROR A DE0A| 6A ROR A DE0B| 29 3F AND #63. DE0D| 85 7E STA Z7E DE0F| C5 8C CMP Z8C DE11| 10** BPL $01 DE13| DE13| BA TSX DE14| E8 INX DE15| 8A TXA DE16| 65 7E ADC Z7E DE18| AA TAX DE19| BD 0001 LDA STACK,X DE1C| A4 7F LDY Z7E+1 DE1E| 39 **** AND BITVAL,Y DE21| F0** BEQ $01 DE23| DE23| A6 70 LDX Z70 DE25| 9A TXS DE26| A9 00 LDA #0 DE28| 48 PHA DE29| A9 01 LDA #1 DE2B| 48 PHA DE2C| 4C AED2 JMP UPIPC1 DE2F| DE2F| A6 70 $01 LDX Z70 DE31| 9A TXS DE32| A9 00 LDA #0 DE34| 48 PHA DE35| 48 PHA DE36| 4C AED2 JMP UPIPC1 DE39| DE39| DE39| ; Table containing value of each bit in a byte DE39| 01 02 04 08 10 20 40 BITVAL .BYTE 1.,2.,4.,8.,16.,32.,64.,128. DE40| 80 DE41| DE41| DE41| ;--------------------------------------------------- DE41| ; BUILD A ONE-MEMBER SET: SGS DE41| ; If the integer tos is in the range 0<=tos<=511, DE41| ; push the set [tos]. If not, execution error. DE41| ;--------------------------------------------------- DE41| ; SGS (build singleton set) p-code: Copies TOS and DE41| ; falls through to the SRS routine below. DE41| ;--------------------------------------------------- DE41| 68 SGS PLA DE42| 85 8A STA Z8A DE44| 68 PLA DE45| 85 8B STA Z8A+1 DE47| A5 8B LDA Z8A+1 DE49| 48 PHA DE4A| A5 8A LDA Z8A DE4C| 48 PHA DE4D| A5 8B LDA Z8A+1 DE4F| 48 PHA DE50| A5 8A LDA Z8A DE52| 48 PHA DE53| DE53| DE53| ;--------------------------------------------------- DE53| ; BUILD A SUBRANGE SET: SRS DE53| ; If the integer tos is in the range 0<=tos<=511, DE53| ; and the integer tos-1 is in the same range, push DE53| ; the set [tos-1..tos] (push the set [] if tos-1> DE53| ; tos). If either integer exceeds the range, give DE53| ; an execution error. DE53| ;--------------------------------------------------- DE53| ; SRS (build subrange set) p-code: Two words are DE53| ; popped and stored in $7A..7D. These are replaced DE53| ; with the set [low..high]. First, check that low DE53| ; >= 0 (execution error if < 0). Next make sure DE53| ; high < 512 (execution error if not). If high < DE53| ; low, push a null set (two zeros) onto the stack. DE53| ; Then the set consisting of zero bits up to the DE53| ; low bit is pushed, between low and high 1s are DE53| ; pushed, and finally the size word is pushed. DE53| ; There is a table containing the bit masks. DE53| ;--------------------------------------------------- DE53| 68 SRS PLA DE54| 85 84 STA Z84 DE56| 68 PLA DE57| 85 85 STA Z84+1 DE59| 68 PLA DE5A| 85 86 STA Z86 DE5C| 68 PLA DE5D| 85 87 STA Z86+1 DE5F| A5 87 LDE5F LDA Z86+1 DE61| 10** BPL $01 DE63| 4C **** JMP $12 DE66| A5 85 $01 LDA Z84+1 DE68| 29 FE AND #0FE DE6A| F0** BEQ $02 DE6C| 4C **** JMP $12 DE6F| 38 $02 SEC DE70| A5 84 LDA Z84 DE72| E5 86 SBC Z86 DE74| 85 88 STA Z88 DE76| A5 85 LDA Z84+1 DE78| E5 87 SBC Z86+1 DE7A| 85 89 STA Z88+1 DE7C| A5 89 LDA Z88+1 DE7E| 10** BPL $03 DE80| 4C **** JMP $11 DE83| A5 86 $03 LDA Z86 DE85| 29 0F AND #0F DE87| 0A ASL A DE88| 85 7F STA Z7E+1 DE8A| A5 86 LDA Z86 DE8C| A2 04 LDX #4 DE8E| 66 87 $04 ROR Z86+1 DE90| 6A ROR A DE91| CA DEX DE92| D0FA BNE $04 DE94| DE94| 85 7E STA Z7E DE96| A5 84 LDA Z84 DE98| 29 0F AND #0F DE9A| 0A ASL A DE9B| 85 81 STA Z80+1 DE9D| A5 84 LDA Z84 DE9F| A2 04 LDX #4 DEA1| 66 85 $05 ROR Z84+1 DEA3| 6A ROR A DEA4| CA DEX DEA5| D0FA BNE $05 DEA7| DEA7| 85 80 STA Z80 DEA9| 38 SEC DEAA| A5 80 LDA Z80 DEAC| E5 7E SBC Z7E DEAE| AA TAX DEAF| A4 81 LDY Z80+1 DEB1| B9 **** LDA LDF1B,Y DEB4| 85 82 STA Z82 DEB6| B9 **** LDA LDF1C,Y DEB9| 85 83 STA Z82+1 DEBB| E0 00 CPX #0 DEBD| F0** BEQ $08 DEBF| DEBF| A5 83 LDA Z82+1 DEC1| 48 PHA DEC2| A5 82 LDA Z82 DEC4| 48 PHA DEC5| A9 FF LDA #0FF DEC7| 85 82 STA Z82 DEC9| 85 83 STA Z82+1 DECB| D0** BNE $07 DECD| DECD| A5 83 $06 LDA Z82+1 DECF| 48 PHA DED0| A5 82 LDA Z82 DED2| 48 PHA DED3| CA $07 DEX DED4| D0F7 BNE $06 DED6| DED6| A5 82 $08 LDA Z82 DED8| A4 7F LDY Z7E+1 DEDA| 39 **** AND LDF3B,Y DEDD| 85 82 STA Z82 DEDF| A5 83 LDA Z82+1 DEE1| 39 **** AND LDF3C,Y DEE4| 85 83 STA Z82+1 DEE6| A5 83 LDA Z82+1 DEE8| 48 PHA DEE9| A5 82 LDA Z82 DEEB| 48 PHA DEEC| A9 00 LDA #0 DEEE| 85 82 STA Z82 DEF0| 85 83 STA Z82+1 DEF2| A6 7E LDX Z7E DEF4| F0** BEQ $10 DEF6| DEF6| A5 83 $09 LDA Z82+1 DEF8| 48 PHA DEF9| A5 82 LDA Z82 DEFB| 48 PHA DEFC| CA DEX DEFD| D0F7 BNE $09 DEFF| DEFF| A9 00 $10 LDA #0 DF01| 48 PHA DF02| 18 CLC DF03| A5 80 LDA Z80 DF05| 69 01 ADC #1 DF07| 48 PHA DF08| 4C AED2 JMP UPIPC1 DF0B| DF0B| DF0B| ; Jump address DF0B| A9 00 $11 LDA #0 DF0D| 48 PHA DF0E| 48 PHA DF0F| 4C AED2 JMP UPIPC1 DF12| DF12| DF12| ; Jump address DF12| A9 00 $12 LDA #0 DF14| 48 PHA DF15| 48 PHA DF16| 4C E1D1 JMP RNGERR DF19| DF19| DF19| 00 LDF19 .BYTE 0 DF1A| 00 LDF1A .BYTE 0 DF1B| 01 LDF1B .BYTE 1 DF1C| 00 LDF1C .BYTE 0 DF1D| 03 .BYTE 3 DF1E| 00 .BYTE 0 DF1F| 07 .BYTE 7 DF20| 00 0F 00 1F 00 3F 00 .BYTE 000,00F,000,01F,000,03F,000,07F,000,0FF,000,0FF,001,0FF,003,0FF DF27| 7F 00 FF 00 FF 01 FF DF2E| 03 FF DF30| 07 FF 0F FF 1F FF 3F .BYTE 007,0FF,00F,0FF,01F,0FF,03F,0FF,07F,0FF,0FF DF37| FF 7F FF FF DF3B| FF LDF3B .BYTE 0FF DF3C| FF FE FF FC LDF3C .BYTE 0FF,0FE,0FF,0FC DF40| FF F8 FF F0 FF E0 FF .BYTE 0FF,0F8,0FF,0F0,0FF,0E0,0FF,0C0,0FF,080,0FF,000,0FF,000,0FE,000 DF47| C0 FF 80 FF 00 FF 00 DF4E| FE 00 DF50| FC 00 F8 00 F0 00 E0 .BYTE 0FC,000,0F8,000,0F0,000,0E0,000,0C0,000,080 DF57| 00 C0 00 80 DF5B| DF5B| DF5B| DF5B| ;================================================================= DF5B| DF5B| .INCLUDE LOC1.3:COMP1.3.TEXT DF5B| .PAGE DF5B| ;--------------------------------------------------- DF5B| ; Comparison p-codes DF5B| ; (SC prefix = set comparison) DF5B| ;--------------------------------------------------- DF5B| DF5B| ;--------------------------------------------------- DF5B| ; NONINTEGER COMPARISONS DF5B| ; EQU UB DF5B| ; NEQ UB DF5B| ; LEQ UB DF5B| ; LES UB DF5B| ; GEQ UB DF5B| ; GRT UB DF5B| ; Compare tos-1 to tos, and push the result (TRUE DF5B| ; or FALSE). The type of comparison is specified DF5B| ; by UB: DF5B| ; reals 2 DF5B| ; strings 4 DF5B| ; booleans 6 DF5B| ; sets 8 DF5B| ; byte arrays 10 DF5B| ; words 12 DF5B| ;--------------------------------------------------- DF5B| DF5B| ;--------------------------------------------------- DF5B| ; NEQ (non-integer Not Equal comparison) p-code DF5B| ;--------------------------------------------------- DF5B| A9 06 NEQ LDA #6 DF5D| 10** BPL COMPARE DF5F| DF5F| ;--------------------------------------------------- DF5F| ; GRT (non-integer Greater Than comparison) p-code DF5F| ;--------------------------------------------------- DF5F| A9 04 GRT LDA #4 DF61| 10** BPL COMPARE DF63| DF63| ;--------------------------------------------------- DF63| ; LES (non-integer Less Than comparison) p-code DF63| ;--------------------------------------------------- DF63| A9 02 LES LDA #2 DF65| 10** BPL COMPARE DF67| DF67| ;--------------------------------------------------- DF67| ; GEQ (non-integer Greater Than or Equal) p-code DF67| ;--------------------------------------------------- DF67| A9 05 GEQ LDA #5 DF69| 10** BPL COMPARE DF6B| DF6B| ;--------------------------------------------------- DF6B| ; LEQ (non-integer Less Than or Equal) p-code DF6B| ;--------------------------------------------------- DF6B| A9 03 LEQ LDA #3 DF6D| 10** BPL COMPARE DF6F| DF6F| ;--------------------------------------------------- DF6F| ; EQU (non-integer Equal comparison) p-code DF6F| ;--------------------------------------------------- DF6F| A9 01 EQU LDA #1 DF71| DF71| ;--------------------------------------------------- DF71| ; Comparison lead-in : Handles the EQUxxx, DF71| ; NEQxxx, LEQxxx, LESxxx, GEQxxx, and GTRxxx routines. DF71| ; The individual entry points load the A-reg with a DF71| ; 3 bit value according to the test being made: DF71| ; Bit 0 = 1: Test for equality DF71| ; = 0: Test for ineqality DF71| ; Bit 1 = 1: Test for less than DF71| ; = 0: Test for not less than DF71| ; Bit 2 = 1: Test for greater than DF71| ; = 0: Test for not greater than DF71| ; Examples: A-reg = 1 for EQUxxx DF71| ; 3 for LEQxxx DF71| ; 4 for GTRxxx DF71| ; The comparison flag is saved at $76 (CP_TYPE). DF71| ; The second byte following the opcode is fetched, to DF71| ; determine whether a Boolean, string, set or array DF71| ; operation is to be performed. If 2, two REALs DF71| ; are compared; if 4, two STRINGs; if 6, BOOLEANs; DF71| ; if 8, two SETs, if 10, two word arrays; otherwise DF71| ; two byte arrays are compared. DF71| ;--------------------------------------------------- DF71| 85 76 COMPARE STA CP_TYPE ; Save comparison type. DF73| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. DF76| A0 01 LDY #1 ; Get next byte DF78| B1 58 LDA @IPC,Y ; from code stream. DF7A| 8D 02C0 STA RDMAINRAM ; Read from main RAM again. DF7D| C9 02 CMP #2 ; Jump to proper comparison: DF7F| D0** BNE $01 DF81| 4C **** JMP RCOMP ; REAL comparison. DF84| C9 04 $01 CMP #4 DF86| D0** BNE $02 DF88| 4C **** JMP SCOMP ; STRING comparison DF8B| C9 06 $02 CMP #6 DF8D| D0** BNE $03 DF8F| 4C **** JMP BOCOMP ; BOOLEAN comparison DF92| C9 08 $03 CMP #8 DF94| D0** BNE $04 DF96| 4C **** JMP SETCOMP ; SET comparison DF99| C9 0A $04 CMP #10. DF9B| F0** BEQ BCOMP ; BYTE comparison DF9D| D0** BNE WCOMP ; WORD comparison DF9F| DF9F| DF9F| ;--------------------------------------------------- DF9F| ; BYTE and WORD comparisons: The compare byte entry DF9F| ; point and compare word entry point both call DF9F| ; GETBIG to fetch the operand that follows in the DF9F| ; code stream. The compare byte entry divides DF9F| ; the BIG parameter by 2 to get byte offset, then DF9F| ; jumps into the compare word routine. The shared DF9F| ; code pops two array pointers and compares the DF9F| ; arrays pointed at by these pointers. Upon determining DF9F| ; the arrays are equal or not equal, control is DF9F| ; transferred to the proper "Push Boolean" routine. DF9F| ;--------------------------------------------------- DF9F| A0 02 BCOMP LDY #2 DFA1| 20 55D1 JSR GETBIG DFA4| 46 69 LSR BIG+1 DFA6| 66 68 ROR BIG DFA8| 4C **** JMP WBCOM DFAB| DFAB| ;--------------------------------------------------- DFAB| ; Entry point for WORD comparison DFAB| ;--------------------------------------------------- DFAB| A0 02 WCOMP LDY #2 DFAD| 20 55D1 JSR GETBIG DFB0| DFB0| ; Shared code for WORD and BYTE comparisons DFB0| DFB0| 68 WBCOM PLA DFB1| 85 80 STA CP_OPR2 DFB3| 68 PLA DFB4| 85 81 STA CP_OPR2+1 DFB6| 68 PLA DFB7| 85 7E STA CP_OPR1 DFB9| 68 PLA DFBA| 85 7F STA CP_OPR1+1 DFBC| E6 58 INC IPC DFBE| D0** BNE $01 DFC0| E6 59 INC IPC+1 DFC2| A0 00 $01 LDY #0 DFC4| A6 68 LDX BIG DFC6| 4C **** JMP $05 DFC9| DFC9| B1 7E $02 LDA @CP_OPR1,Y DFCB| D1 80 CMP @CP_OPR2,Y DFCD| D0** BNE $06 DFCF| DFCF| E6 7E INC CP_OPR1 DFD1| D0** BNE $03 DFD3| E6 7F INC CP_OPR1+1 DFD5| E6 80 $03 INC CP_OPR2 DFD7| D0** BNE $04 DFD9| E6 81 INC CP_OPR2+1 DFDB| CA $04 DEX DFDC| D0EB $05 BNE $02 DFDE| DFDE| C6 69 DEC BIG+1 DFE0| 10E7 BPL $02 DFE2| 4C **** JMP PUSHEQ ; Arrays are equal. DFE5| B0** $06 BCS $07 DFE7| 4C **** JMP PUSHGT ; Array 1 > array 2 DFEA| 4C **** $07 JMP PUSHLT ; Array 1 < array 2 DFED| DFED| DFED| 8800 A_Z88 .WORD Z88 DFEF| 8A00 A_Z8A .WORD Z8A DFF1| DFF1| DFF1| ;--------------------------------------------------- DFF1| ; STRING comparison routine: Compares two strings DFF1| ; whose pointers are found on TOS. It is complicated DFF1| ; because if the high order byte of the pointer = 0, DFF1| ; the string consists of a single character. If a DFF1| ; single character is detected (for either pointer), DFF1| ; it is converted to a string by storing it on zero DFF1| ; page and prefacing it with a length byte = 1. The DFF1| ; normal string pointer is set up to point at this DFF1| ; zero page location. Locations $7E/7F point at the DFF1| ; 1st string (with $8A/8B used for single character DFF1| ; string) and $8)/81 point at the second string DFF1| ; (with $88/89 used for a single character). Once DFF1| ; the pointers are set up, the lengths are compared DFF1| ; and the minimum is loaded into X-reg. The strings DFF1| ; are then compared until it is determined they are DFF1| ; not equal or are equal through the length of the DFF1| ; shorter string. Control then passes to the proper DFF1| ; "Push Boolean" routine. DFF1| ;--------------------------------------------------- DFF1| 68 SCOMP PLA DFF2| 85 80 STA CP_OPR2 DFF4| 68 PLA DFF5| 85 81 STA CP_OPR2+1 DFF7| D0** BNE $01 DFF9| A5 80 LDA CP_OPR2 DFFB| 85 89 STA Z88+1 DFFD| A9 01 LDA #1 DFFF| 85 88 STA Z88 E001| AD EDDF LDA A_Z88 E004| 85 80 STA CP_OPR2 E006| AD EEDF LDA A_Z88+1 E009| 85 81 STA CP_OPR2+1 E00B| 68 $01 PLA E00C| 85 7E STA CP_OPR1 E00E| 68 PLA E00F| 85 7F STA CP_OPR1+1 E011| D0** BNE $02 E013| E013| A5 7E LDA CP_OPR1 E015| 85 8B STA Z8A+1 E017| A9 01 LDA #1 E019| 85 8A STA Z8A E01B| AD EFDF LDA A_Z8A E01E| 85 7E STA CP_OPR1 E020| AD F0DF LDA A_Z8A+1 E023| 85 7F STA CP_OPR1+1 E025| A0 00 $02 LDY #0 E027| B1 7E LDA @CP_OPR1,Y E029| D1 80 CMP @CP_OPR2,Y E02B| 90** BCC $03 E02D| E02D| B1 80 LDA @CP_OPR2,Y E02F| AA $03 TAX E030| E8 INX E031| CA $04 DEX E032| F0** BEQ $05 E034| C8 INY E035| B1 7E LDA @CP_OPR1,Y E037| D1 80 CMP @CP_OPR2,Y E039| F0F6 BEQ $04 E03B| B0** BCS PUSHLT E03D| 90** BCC PUSHGT E03F| E03F| A0 00 $05 LDY #0 E041| B1 7E LDA @CP_OPR1,Y E043| D1 80 CMP @CP_OPR2,Y E045| 90** BCC PUSHGT E047| F0** BEQ PUSHEQ E049| D0** BNE PUSHLT E04B| E04B| E04B| ;--------------------------------------------------- E04B| ; Push Boolean routines: The first entry point is E04B| ; jumped to when the comparison routine determines E04B| ; the first parameter is > the second. It pushes E04B| ; TRUE onto the stack if GTRxxx, GEQxxx, or NEQxxx E04B| ; opcode was being processed, FALSE otherwise. E04B| ; The second entry is jumped to if the comparison E04B| ; determined the two values being compared are =. E04B| ; TRUE is pushed if GQLxxx, GEQxxx, or LEQxxx is E04B| ; being processed. E04B| ; The third entry point is jumped to if the E04B| ; comparison determined the 1st value < the 2nd. E04B| ; TRUE is pushed if LESxxx, LEQxxx, or NEQxxx is E04B| ; being processed. E04B| ; The final entry point is used by all these routines. E04B| ; It is responsible for pushing TRUE or FALSE and E04B| ; determining which opcode is being processes. E04B| ;--------------------------------------------------- E04B| ; "<" entry at PUSHLT E04B E04B| ; "=" entry at PUSHEQ E04F E04B| ; ">" entry at PUSHGT E053 E04B| A9 04 PUSHLT LDA #4 E04D| 10** BPL PUSHBOOL E04F| E04F| A9 01 PUSHEQ LDA #1 E051| 10** BPL PUSHBOOL E053| E053| A9 02 PUSHGT LDA #2 E055| E055| 25 76 PUSHBOOL AND CP_TYPE E057| F0** BEQ $01 E059| A9 00 LDA #0 E05B| 48 PHA E05C| A9 01 LDA #1 ; Push TRUE E05E| 48 PHA E05F| 4C 88D2 JMP UPIPC2 E062| E062| A9 00 $01 LDA #0 E064| 48 PHA E065| 48 PHA ; Push FALSE E066| 4C 88D2 JMP UPIPC2 E069| E069| E069| ;--------------------------------------------------- E069| ; REAL comparisons: Pops two real values off the E069| ; stack and compares them. Control then passes to E069| ; the proper "Push Boolean" routine. E069| ;--------------------------------------------------- E069| A2 07 RCOMP LDX #7 E06B| 68 $01 PLA E06C| 95 7E STA CP_OPR1,X E06E| CA DEX E06F| 10FA BPL $01 E071| E071| A0 01 LDY #1 E073| A9 80 LDA #080 E075| 45 82 EOR Z82 E077| 85 82 STA Z82 E079| 30** BMI $02 E07B| E07B| A5 7E LDA CP_OPR1 E07D| 10** BPL $02 E07F| E07F| A0 F4 LDY #244. E081| A9 80 $02 LDA #080 E083| 45 7E EOR CP_OPR1 E085| 85 7E STA CP_OPR1 E087| A2 00 LDX #0 E089| B5 7E $03 LDA CP_OPR1,X E08B| D5 82 CMP Z82,X E08D| D0** BNE $04 E08F| E8 INX E090| E0 04 CPX #4 E092| D0F5 BNE $03 E094| F0B9 BEQ PUSHEQ E096| E096| 98 $04 TYA E097| 30** BMI $05 E099| B0B0 BCS PUSHLT E09B| 4C 53E0 JMP PUSHGT E09E| E09E| 90AB $05 BCC PUSHLT E0A0| 4C 53E0 JMP PUSHGT E0A3| E0A3| E0A3| ;--------------------------------------------------- E0A3| ; BOOLEAN comparisons: TOS is popped, ANDed with 1, E0A3| ; and compared to TOS-1 after it is popped and ANDed E0A3| ; with 1. Control then passes to the proper "Push E0A3| ; Boolean" routine. E0A3| ;--------------------------------------------------- E0A3| ; At location E0A3 E0A3| 68 BOCOMP PLA E0A4| 29 01 AND #1 E0A6| 85 7E STA CP_OPR1 E0A8| 68 PLA E0A9| 68 PLA E0AA| 29 01 AND #1 E0AC| A8 TAY E0AD| 68 PLA E0AE| 98 TYA E0AF| C5 7E CMP CP_OPR1 E0B1| 90A0 BCC PUSHGT E0B3| F09A BEQ PUSHEQ E0B5| 4C 4BE0 JMP PUSHLT E0B8| E0B8| .PAGE E0B8| ;--------------------------------------------------- E0B8| ; INTEGER COMPARISONS E0B8| ; EQUI UB E0B8| ; NEQI UB E0B8| ; LEQI UB E0B8| ; LESI UB E0B8| ; GEQI UB E0B8| ; GRTI UB E0B8| ; Compare tos-1 to tos, and push the result (TRUE E0B8| ; or FALSE). E0B8| ;--------------------------------------------------- E0B8| E0B8| ;--------------------------------------------------- E0B8| ; LESI (Integer Less-Than) p-code E0B8| ;--------------------------------------------------- E0B8| A9 02 LESI LDA #2 E0BA| 10** BPL INTCOMP E0BC| E0BC| ;--------------------------------------------------- E0BC| ; GTRI (Integer Greater-Than) p-code E0BC| ;--------------------------------------------------- E0BC| A9 04 GTRI LDA #4 E0BE| 10** BPL INTCOMP E0C0| E0C0| ;--------------------------------------------------- E0C0| ; LEQI (Integer Less-Than-or-Equal) p-code E0C0| ;--------------------------------------------------- E0C0| A9 03 LEQI LDA #3 E0C2| 10** BPL INTCOMP E0C4| E0C4| ;--------------------------------------------------- E0C4| ; GEQI (Integer Greater-Than-or-Equal) p-code E0C4| ;--------------------------------------------------- E0C4| A9 05 GEQI LDA #5 E0C6| 10** BPL INTCOMP E0C8| E0C8| ;--------------------------------------------------- E0C8| ; NEQI (Integer Not-Equal) p-code E0C8| ;--------------------------------------------------- E0C8| A9 06 NEQI LDA #6 E0CA| E0CA| ;--------------------------------------------------- E0CA| ; Integer comparison routines entry point: compare E0CA| ; two words on TOS and push TRUE if the comparison E0CA| ; holds, FALSE if not. All these comparisons except E0CA| ; EQUI are handled in a fashion similar to the E0CA| ; comparisons above in that a three-bit value is E0CA| ; saved and a single comparison routine is jumped E0CA| ; to in the interest in saving code. EQUI is coded E0CA| ; separately probably because it is called so often. E0CA| ;--------------------------------------------------- E0CA| 85 76 INTCOMP STA CP_TYPE E0CC| 68 PLA E0CD| 85 80 STA CP_OPR2 E0CF| 68 PLA E0D0| 85 81 STA CP_OPR2+1 E0D2| 68 PLA E0D3| 85 7E STA CP_OPR1 E0D5| 68 PLA E0D6| 85 7F STA CP_OPR1+1 E0D8| 45 81 EOR CP_OPR2+1 E0DA| 30** BMI $02 E0DC| E0DC| A5 7F LDA CP_OPR1+1 E0DE| C5 81 CMP CP_OPR2+1 E0E0| D0** BNE $01 E0E2| E0E2| A5 7E LDA CP_OPR1 E0E4| C5 80 CMP CP_OPR2 E0E6| F0** BEQ IPSHEQ E0E8| 90** $01 BCC IPSHGT E0EA| B0** BCS IPSHLT E0EC| E0EC| A5 7F $02 LDA CP_OPR1+1 E0EE| 30** BMI IPSHGT E0F0| 10** BPL IPSHLT E0F2| E0F2| ;--------------------------------------------------- E0F2| ; Integer Equal p-code E0F2| ;--------------------------------------------------- E0F2| BA EQUI TSX E0F3| 68 PLA E0F4| DD 0301 CMP STACK+3,X E0F7| D0** BNE $01 E0F9| 68 PLA E0FA| DD 0401 CMP STACK+4,X E0FD| D0** BNE $02 E0FF| A9 00 LDA #0 E101| 9D 0401 STA STACK+4,X E104| A9 01 LDA #1 E106| 9D 0301 STA STACK+3,X E109| 4C AED2 JMP UPIPC1 E10C| E10C| 68 $01 PLA E10D| A9 00 LDA #0 E10F| 9D 0401 STA STACK+4,X E112| 9D 0301 STA STACK+3,X E115| 4C AED2 JMP UPIPC1 E118| E118| A9 00 $02 LDA #0 E11A| 9D 0401 STA STACK+4,X E11D| 9D 0301 STA STACK+3,X E120| 4C AED2 JMP UPIPC1 E123| E123| E123| ;--------------------------------------------------- E123| ; Push the result of the integer compare. E123| ;--------------------------------------------------- E123| E123| A9 00 ICOMFLS LDA #0 E125| 48 PHA E126| A9 01 LDA #1 ; Push TRUE E128| 48 PHA E129| 4C AED2 JMP UPIPC1 E12C| E12C| A9 04 IPSHLT LDA #4 ; Comparison is < E12E| 10** BPL IPSH01 E130| A9 01 IPSHEQ LDA #1 ; Comparison is = E132| 10** BPL IPSH01 E134| A9 02 IPSHGT LDA #2 ; Comparison is > E136| E136| 25 76 IPSH01 AND CP_TYPE E138| D0E9 BNE ICOMFLS E13A| E13A| A9 00 LDA #0 E13C| 48 PHA E13D| 48 PHA ; Push FALSE E13E| 4C AED2 JMP UPIPC1 E141| E141| .PAGE E141| ;--------------------------------------------------- E141| ; Set comparison setup routine: Computes various E141| ; pieces of data needed by the set comparison E141| ; routines. It returns the size of the set on TOS E141| ; (set B) in SC_SIZEB, the size of set on TOS-1 E141| ; (set A) in SC_SIZEA, the addr of set B in loc E141| ; $8A (set is always on page 1), addr of set A in E141| ; $7E, the difference in size (A - B) in $90, the E141| ; min(sizeA,sizeB) in $88 E141| ;--------------------------------------------------- E141| SC_SETUP E141| 68 PLA ; Save E142| 85 98 STA SC_RTN ; return E144| 68 PLA ; address. E145| 85 99 STA SC_RTN+1 E147| 68 PLA ; Get size of set B. E148| 0A ASL A ; Double it (for bytes). E149| 85 86 STA SC_SIZEB E14B| 85 88 STA SC_MINAB E14D| 68 PLA ; Ignore high byte. E14E| BA TSX ; Get pointer to E14F| E8 INX ; set B. E150| 86 80 STX CP_OPR2 E152| 8A TXA E153| 18 CLC E154| 65 86 ADC SC_SIZEB E156| AA TAX E157| BD 0001 LDA STACK,X ; Get size of set A. E15A| 0A ASL A ; Double it (for bytes). E15B| 85 84 STA SC_SIZEA E15D| C5 88 CMP SC_MINAB E15F| 10** BPL $01 E161| 85 88 STA SC_MINAB ; Save MIN(sizeA, sizeB) E163| 38 $01 SEC E164| E5 86 SBC SC_SIZEB E166| 85 90 STA SC_DIFAB ; Save MINAB - sizeB E168| E8 INX E169| 8A TXA E16A| 18 CLC E16B| 65 84 ADC SC_SIZEA E16D| 85 8A STA SC_SETB ; Save addr of set B. E16F| E8 INX E170| 86 7E STX SC_SETA ; Save addr of set A. E172| E6 98 INC SC_RTN ; Return to E174| D0** BNE $02 ; caller. E176| E6 99 INC SC_RTN+1 E178| 6C 9800 $02 JMP @SC_RTN E17B| E17B| E17B| ;--------------------------------------------------- E17B| ; Check remainder of set to make sure it contains E17B| ; zeroes. If the sets are of unequal length, this E17B| ; routine is called to make sure that zeroes are E17B| ; present in the high order bytes. Two different E17B| ; entry points are called, depending upon whether E17B| ; set A or B is being checked. The X-reg contains E17B| ; the first byte on the stack to check. E17B| ;--------------------------------------------------- E17B| E17B| A9 00 CHK_B0 LDA #0 E17D| 38 SEC E17E| E5 90 SBC SC_DIFAB E180| A8 TAY E181| 4C **** JMP CHK_0 E184| E184| A4 90 CHK_A0 LDY SC_DIFAB E186| E186| C0 00 CHK_0 CPY #0 E188| F0** BEQ $04 E18A| 30** BMI $04 E18C| 18 CLC E18D| BD 0001 $03 LDA STACK,X E190| D0** BNE $05 ; All elements are 0! E192| E8 INX E193| 88 DEY E194| D0F7 BNE $03 E196| 38 $04 SEC ; Non-zero element found! E197| 60 $05 RTS E198| E198| E198| ;--------------------------------------------------- E198| ; Set comparison routine: compares the sets on TOS. E198| ; If they are equal, the carry is returned set. E198| ; If unequal, the carry is returned cleared. E198| ;--------------------------------------------------- E198| 68 SETCOMR PLA ; Save E199| 85 96 STA SC_RTN0 ; return E19B| 68 PLA ; address. E19C| 85 97 STA SC_RTN0+1 E19E| E19E| 20 41E1 JSR SC_SETUP E1A1| E1A1| A6 7E LDX SC_SETA E1A3| A4 88 LDY SC_MINAB E1A5| F0** BEQ $02 E1A7| 68 $01 PLA E1A8| DD 0001 CMP STACK,X E1AB| D0** BNE $04 E1AD| E8 INX E1AE| 88 DEY E1AF| D0F6 BNE $01 E1B1| E1B1| A5 90 $02 LDA SC_DIFAB E1B3| 30** BMI $03 E1B5| 20 84E1 JSR CHK_A0 ; Make sure rest of set is 0. E1B8| 4C **** JMP $05 E1BB| E1BB| BA $03 TSX E1BC| E8 INX E1BD| 20 7BE1 JSR CHK_B0 ; Make sure rest of set is 0. E1C0| 4C **** JMP $05 E1C3| E1C3| 18 $04 CLC E1C4| E1C4| E6 96 $05 INC SC_RTN0 ; Return to E1C6| D0** BNE $06 ; caller. E1C8| E6 97 INC SC_RTN0+1 E1CA| 6C 9600 $06 JMP @SC_RTN0 E1CD| E1CD| E1CD| ;--------------------------------------------------- E1CD| ; Set comparison routine. This subroutine is called E1CD| ; to compare the sets on TOS. If they are equal, E1CD| ; the carry is returned set. If they are not equal, E1CD| ; the carry is returned cleared. E1CD| ;--------------------------------------------------- E1CD| A5 76 SETCOMP LDA CP_TYPE E1CF| C9 01 CMP #1 E1D1| D0** BNE $01 E1D3| 4C **** JMP SETEQL ; Type 1: Equality E1D6| C9 06 $01 CMP #6 E1D8| D0** BNE $02 E1DA| 4C **** JMP SETNEQ ; Type 6: Inequality E1DD| C9 03 $02 CMP #3 E1DF| D0** BNE SETLEQ ; Type 3: <= (A IN B) E1E1| F0** BEQ SETGEQ ; ELSE: >= (B IN A) E1E3| E1E3| E1E3| ;--------------------------------------------------- E1E3| ; Set equality comparison E1E3| ;--------------------------------------------------- E1E3| 20 98E1 SETEQL JSR SETCOMR E1E6| 4C **** JMP SC_EXIT ; Push result & return. E1E9| E1E9| E1E9| ;--------------------------------------------------- E1E9| ; Set inequality comparison E1E9| ;--------------------------------------------------- E1E9| 20 98E1 SETNEQ JSR SETCOMR E1EC| B0** BCS $05 E1EE| 38 SEC E1EF| B0** BCS $06 E1F1| 18 $05 CLC E1F2| 4C **** $06 JMP SC_EXIT ; Push result & return. E1F5| E1F5| E1F5| ;--------------------------------------------------- E1F5| ; Set greater or equal comparison E1F5| ;--------------------------------------------------- E1F5| 20 41E1 SETGEQ JSR SC_SETUP E1F8| A6 7E LDX SC_SETA E1FA| A4 88 LDY SC_MINAB E1FC| F0** BEQ $09 E1FE| E1FE| 68 $08 PLA E1FF| 49 FF EOR #0FF E201| 3D 0001 AND STACK,X E204| D0** BNE SC_FALSE E206| E8 INX E207| 88 DEY E208| D0F4 BNE $08 E20A| E20A| 20 84E1 $09 JSR CHK_A0 ; Make sure rest of set is 0. E20D| 4C **** JMP SC_EXIT ; Push result & return. E210| E210| E210| ;--------------------------------------------------- E210| ; Set less or equal comparison E210| ;--------------------------------------------------- E210| 20 41E1 SETLEQ JSR SC_SETUP E213| A4 7E LDY SC_SETA E215| BA TSX E216| E8 INX E217| A5 88 LDA SC_MINAB E219| F0** BEQ $12 E21B| E21B| B9 0001 $11 LDA STACK,Y ; Get 8 elements from set Y, E21E| 49 FF EOR #0FF ; negate, E220| 3D 0001 AND STACK,X ; AND with elements from set X. E223| D0** BNE SC_FALSE ; If <>, clear carry and return. E225| E8 INX ; Bump the element E226| C8 INY ; pointers. E227| C6 88 DEC SC_MINAB ; Decrement size counter. Stay E229| D0F0 BNE $11 ; in loop until all are checked. E22B| 20 7BE1 $12 JSR CHK_B0 ; Make sure rest of set is 0. E22E| 4C **** JMP SC_EXIT ; Push result & return. E231| E231| E231| 18 SC_FALSE CLC ; Result is FALSE! E232| E232| E232| ;--------------------------------------------------- E232| ; Set compare exit point. If carry is clear, push E232| ; FALSE, else push TRUE. E232| ;--------------------------------------------------- E232| A6 8A SC_EXIT LDX SC_SETB ; Restore stack E234| 9A TXS ; pointer. E235| A0 00 LDY #0 ; High order byte of E237| 84 8F STY CP_RSLT+1 ; result is always 0. E239| 90** BCC $15 ; If carry is set, E23B| C8 INY ; low order byte is 1. E23C| 84 8E $15 STY CP_RSLT ; Store FALSE (0) or TRUE (1) E23E| A5 8F LDA CP_RSLT+1 ; Push result E240| 48 PHA ; onto stack. E241| A5 8E LDA CP_RSLT E243| 48 PHA E244| 4C 88D2 JMP UPIPC2 ; Return to main loop. E247| E247| E247| E247| E247| ;================================================================= E247| E247| .INCLUDE LOC1.3:SUBS1.3.TEXT E247| .PAGE E247| ;--------------------------------------------------- E247| ; Interpreter code dealing with subprograms E247| ; E247| ; The general method of procedure/function E247| ; invocation: E247| ; 1. Find the procedure code of the called proc. E247| ; 2. From the DATA SIZE and PARAM SIZE fields of E247| ; the attribute table of the called proc, E247| ; determine the size (in bytes) of the needed E247| ; activation record, and extend the program stack E247| ; by that number of bytes. E247| ; 3. Copy the number of bytes specified by the PARAM E247| ; SIZE field from the top of the evaluation stack E247| ; (tos) to the beginning of the space allocated E247| ; on the program stack. This passes parameters to E247| ; the new proc from its calling procedure. E247| ; 4. Build a markstack, saving the SP, IPC, SEG, E247| ; JTAB, STRP, MP, and a static link pointer E247| ; (MSSTAT) to the most recently activation record E247| ; of the proc that is the lexical parent of the E247| ; called procedure. E247| ; 5. Calculate new values for the SP, IPC, JTAB, and E247| ; MP registers; if necessary, calculate a new E247| ; value for the SEG register. Issue an exec error E247| ; if the prog stack overflows. E247| ; 6. If the called proc has a lexical level of -1 or E247| ; 0 (ie, if it's a base proc) save the value of E247| ; the BASE reg on the evaluation stack and then E247| ; equate the BASE reg with the MP register. E247| ; 7. Save the value of the KP reg on prog stack. E247| ; 8. Calculate new value for KP register. E247| ;--------------------------------------------------- E247| E247| ;--------------------------------------------------- E247| ; CXP utility routine: Fetches the segment number E247| ; from the segment table and stores it into the E247| ; "nextseg" register. It then jumps to common E247| ; procedure code shared with other opcodes. E247| ;--------------------------------------------------- E247| 68 CXPUTIL PLA ; Save return E248| 85 98 STA S_RET ; address. E24A| 68 PLA E24B| 85 99 STA S_RET+1 E24D| A5 90 LDA SEGNUM ; Get segment #, E24F| 0A ASL A ; double it, and E250| A8 TAY ; use as word offset. E251| B9 9EBC LDA SEG_ADDR,Y ; Get address of E254| 85 8C STA S_NXTSEG ; segment from E256| 85 7E STA P_DICT ; system table. E258| B9 9FBC LDA SEG_ADDR+1,Y E25B| 85 8D STA S_NXTSEG+1 E25D| 85 7F STA P_DICT+1 E25F| 4C **** JMP CALLSETUP ; Do rest of call setup. E262| E262| E262| ;--------------------------------------------------- E262| ; Normal procedure call utility subroutine: copies E262| ; the current contents of the segment registers E262| ; into the "nextseg" memory location. It also E262| ; stores $FF in the segment number variable; this E262| ; is used by the common code to differentiate E262| ; between an external procedure and a normal E262| ; procedure call. E262| ;--------------------------------------------------- E262| CALLUTIL E262| 68 PLA ; Save return E263| 85 98 STA S_RET ; address. E265| 68 PLA E266| 85 99 STA S_RET+1 E268| A5 56 LDA SEG ; Set segment address E26A| 85 8C STA S_NXTSEG ; from current segment E26C| 85 7E STA P_DICT ; register. E26E| A5 57 LDA SEG+1 E270| 85 8D STA S_NXTSEG+1 E272| 85 7F STA P_DICT+1 E274| A9 FF LDA #255. ; Set segment # E276| 85 90 STA SEGNUM ; to 255. E278| E278| ;--------------------------------------------------- E278| ; Common code for CXP and Normal call subroutines. E278| ; Pushes return addresses, parameters, loads in E278| ; segment procedures, etc. whenever a procedure E278| ; or function is invoked. E278| ;--------------------------------------------------- E278| CALLSETUP E278| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E27B| A5 5C LDA KP ; Save stack pointer E27D| 85 84 STA OLD_KP ; before the call. E27F| A5 5D LDA KP+1 E281| 85 85 STA OLD_KP+1 E283| A5 7E LDA P_DICT E285| ; Get address of procedure dictionary for current segment E285| 38 SEC E286| E5 82 SBC PROCNUM E288| 85 7E STA P_DICT E28A| B0** BCS $01 E28C| C6 7F DEC P_DICT+1 E28E| A5 7E $01 LDA P_DICT E290| 38 SEC E291| E5 82 SBC PROCNUM E293| 85 7E STA P_DICT ;Addr := S_NXTSEG - 2*PROCNUM E295| B0** BCS $02 E297| C6 7F DEC P_DICT+1 E299| ; Get address of procedure attribute table for new procedure E299| A0 00 $02 LDY #0 E29B| 38 SEC E29C| A5 7E LDA P_DICT E29E| F1 7E SBC @P_DICT,Y ;Addr := P_DICT - [P_DICT] E2A0| 85 86 STA P_A_TBL E2A2| A5 7F LDA P_DICT+1 E2A4| C8 INY E2A5| F1 7E SBC @P_DICT,Y E2A7| 85 87 STA P_A_TBL+1 E2A9| E2A9| A0 00 LDY #0 E2AB| B1 86 LDA @P_A_TBL,Y ; Get proc number. E2AD| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E2B0| D0** BNE NOTASMB ; If <> 0, not assembly lang. E2B2| E2B2| ; Routine being called is assembly language. E2B2| E2B2| A5 58 LDA IPC ; Increment p-code E2B4| 18 CLC ; instruction counter E2B5| 69 02 ADC #2 ; by 2. E2B7| 85 58 STA IPC E2B9| 90** BCC $03 E2BB| E6 59 INC IPC+1 E2BD| 8D 03C0 $03 STA RDCARDRAM ; Read from p-code RAM. E2C0| 20 **** JSR DEC_PA ; Bump to next attribute. E2C3| 38 SEC ; Put address E2C4| A5 86 LDA P_A_TBL ; of routine into E2C6| F1 86 SBC @P_A_TBL,Y ; locations $9A/9B. E2C8| 85 9A STA SUB_ADR E2CA| C8 INY E2CB| A5 87 LDA P_A_TBL+1 E2CD| F1 86 SBC @P_A_TBL,Y E2CF| 85 9B STA SUB_ADR+1 E2D1| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E2D4| A5 90 LDA SEGNUM ; Save segment number E2D6| 8D **** STA CALLIND ; as call indicator. E2D9| AD **** LDA AE2E4+1 ; Set up 6502 E2DC| 48 PHA ; stack for return E2DD| AD **** LDA AE2E4 ; from subroutine. E2E0| 48 PHA E2E1| 6C 9A00 JMP @SUB_ADR ; Go to assembly lang. E2E4| E2E4| ; Return point from assembly language. E2E4| AD **** ASMRTN LDA CALLIND ; If call indicator E2E7| 30** BMI $01 ; is 0..128, E2E9| 20 **** JSR UNLOADSEG ; unload the segment. E2EC| 4C B4D2 $01 JMP MAINLOOP E2EF| E2EF| E2EF| E3E2 AE2E4 .WORD ASMRTN-1 ; Addr for return from asmb E2F1| 00 CALLIND .BYTE 0 E2F2| E2F2| E2F2| ; The routine being called is P-Code. E2F2| E2F2| A5 86 NOTASMB LDA P_A_TBL ; Point to 4th attribute: E2F4| 38 SEC ; data size (in bytes). E2F5| E9 08 SBC #8 E2F7| 85 86 STA P_A_TBL E2F9| B0** BCS $01 E2FB| C6 87 DEC P_A_TBL+1 E2FD| ; Subtract data size from stack pointer E2FD| 38 $01 SEC E2FE| A0 00 LDY #0 E300| A5 84 LDA OLD_KP E302| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E305| F1 86 SBC @P_A_TBL,Y E307| 85 88 STA NEW_KP E309| A5 85 LDA OLD_KP+1 E30B| C8 INY E30C| F1 86 SBC @P_A_TBL,Y E30E| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E311| 85 89 STA NEW_KP+1 E313| 90** BCC $03 ; Stack overflow! E315| ; Now subtract out the parameter size E315| A0 03 LDY #3 E317| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E31A| B1 86 LDA @P_A_TBL,Y ; Get high byte of param size. E31C| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E31F| D0** BNE $03 ; Stack overflow! E321| 88 DEY E322| A5 88 LDA NEW_KP E324| 38 SEC E325| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E328| F1 86 SBC @P_A_TBL,Y ; Sub low byte of param size. E32A| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E32D| 85 88 STA NEW_KP E32F| B0** BCS $02 E331| A5 89 LDA NEW_KP+1 E333| E9 00 SBC #0 E335| 85 89 STA NEW_KP+1 E337| 90** BCC $03 ; Stack overflow! E339| ; Subtract 12 more bytes from stack pointer E339| ; (size of markstack) E339| A5 88 $02 LDA NEW_KP E33B| 85 74 STA DEST E33D| 38 SEC E33E| E9 0C SBC #12. E340| 85 88 STA NEW_KP E342| A5 89 LDA NEW_KP+1 E344| 85 75 STA DEST+1 E346| E9 00 SBC #0 E348| 85 89 STA NEW_KP+1 E34A| 90** BCC $03 ; Stack overflow! E34C| ; Compare new stack addr to current heap addr. E34C| 38 SEC E34D| A5 88 LDA NEW_KP E34F| E5 5A SBC NP E351| A5 89 LDA NEW_KP+1 E353| E5 5B SBC NP+1 E355| B0** BCS $04 E357| ; Won't fit...try removing directory block E357| 20 BAD1 JSR CHKGDRP E35A| 38 SEC E35B| A5 88 LDA NEW_KP E35D| E5 5A SBC NP E35F| A5 89 LDA NEW_KP+1 E361| E5 5B SBC NP+1 E363| B0** BCS $04 E365| ; The procedure's data/parameters won't fit on the stack! E365| 4C EDD1 $03 JMP STKOVFL E368| E368| E368| ; Everything fits on the stack. E368| ; Build the MarkStack! E368| A0 02 $04 LDY #2 E36A| A5 52 LDA MP ; MSDYN E36C| 91 88 STA @NEW_KP,Y E36E| C8 INY E36F| A5 53 LDA MP+1 E371| 91 88 STA @NEW_KP,Y E373| C8 INY ; MSJTAB E374| A5 54 LDA JTAB E376| 91 88 STA @NEW_KP,Y E378| C8 INY E379| A5 55 LDA JTAB+1 E37B| 91 88 STA @NEW_KP,Y E37D| C8 INY ; MSSEG E37E| A5 56 LDA SEG E380| 91 88 STA @NEW_KP,Y E382| C8 INY E383| A5 57 LDA SEG+1 E385| 91 88 STA @NEW_KP,Y E387| C8 INY ; MSIPC E388| 18 CLC E389| A5 58 LDA IPC E38B| 69 02 ADC #2 E38D| 91 88 STA @NEW_KP,Y E38F| C8 INY E390| A5 59 LDA IPC+1 E392| 69 00 ADC #0 E394| 91 88 STA @NEW_KP,Y E396| E396| ; Move parameters from evaluation stack to program stack E396| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E399| A0 02 LDY #2 E39B| B1 86 LDA @P_A_TBL,Y E39D| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E3A0| A0 00 LDY #0 E3A2| AA TAX E3A3| 4C **** JMP $06 E3A6| 68 $05 PLA E3A7| 91 74 STA @DEST,Y E3A9| C8 INY E3AA| CA DEX E3AB| D0F9 $06 BNE $05 E3AD| E3AD| BA TSX E3AE| 8A TXA E3AF| A0 0A LDY #10. E3B1| 91 88 STA @NEW_KP,Y E3B3| E3B3| A5 86 LDA P_A_TBL E3B5| 18 CLC E3B6| 69 06 ADC #6 E3B8| 85 7E STA P_DICT E3BA| A5 87 LDA P_A_TBL+1 E3BC| 69 00 ADC #0 E3BE| 85 7F STA P_DICT+1 E3C0| E3C0| ; Point IPC to first instruction of procedure E3C0| A0 00 LDY #0 E3C2| 38 SEC E3C3| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E3C6| A5 7E LDA P_DICT E3C8| F1 7E SBC @P_DICT,Y E3CA| 85 58 STA IPC E3CC| A5 7F LDA P_DICT+1 E3CE| C8 INY E3CF| F1 7E SBC @P_DICT,Y E3D1| 85 59 STA IPC+1 E3D3| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E3D6| ; Set up other p-machine registers E3D6| A5 86 LDA P_A_TBL E3D8| 18 CLC E3D9| 69 08 ADC #8 E3DB| 85 54 STA JTAB E3DD| A5 87 LDA P_A_TBL+1 E3DF| 69 00 ADC #0 E3E1| 85 55 STA JTAB+1 E3E3| A5 88 LDA NEW_KP E3E5| 85 52 STA MP E3E7| 8D 2CBD STA LASTMP E3EA| A5 89 LDA NEW_KP+1 E3EC| 85 53 STA MP+1 E3EE| 8D 2DBD STA LASTMP+1 E3F1| A5 88 LDA NEW_KP E3F3| 38 SEC E3F4| E9 04 SBC #4 E3F6| 85 80 STA Z80 E3F8| A5 89 LDA NEW_KP+1 E3FA| E9 00 SBC #0 E3FC| 85 81 STA Z80+1 E3FE| A0 00 LDY #0 E400| A5 5E LDA STRP E402| 91 80 STA @Z80,Y E404| C8 INY E405| A5 5F LDA STRP+1 E407| 91 80 STA @Z80,Y E409| C8 INY E40A| A5 5C LDA KP E40C| 91 80 STA @Z80,Y E40E| C8 INY E40F| A5 5D LDA KP+1 E411| 91 80 STA @Z80,Y E413| A5 80 LDA Z80 E415| 85 5C STA KP E417| A5 81 LDA Z80+1 E419| 85 5D STA KP+1 E41B| A9 00 LDA #0 E41D| 85 5E STA STRP E41F| 85 5F STA STRP+1 E421| A5 8C LDA S_NXTSEG E423| 85 56 STA SEG E425| A5 8D LDA S_NXTSEG+1 E427| 85 57 STA SEG+1 E429| E429| E6 98 INC S_RET ; Return E42B| D0** BNE $07 ; to E42D| E6 99 INC S_RET+1 ; caller. E42F| 6C 9800 $07 JMP @S_RET E432| E432| E432| ;--------------------------------------------------- E432| ; CALL INTERMEDIATE PROCEDURE: CIP UB E432| ; Call procedure number UB in the same segment as E432| ; the currently executing proc. The MSSTAT field E432| ; (static link) of the markstack is set by looking E432| ; up the dynamic chain (MSDYN) until an activation E432| ; rec is found whose caller has a lexical level 1 E432| ; less than the proc being called. Use that actvtn E432| ; rec's MSSTAT field (static link) as the static E432| ; link of the new markstack. E432| ;--------------------------------------------------- E432| ; CIP (call intermediate) p-code: First, the proc E432| ; call subroutine is called to set up the stack, E432| ; then the code looks into the procedure table to E432| ; get at the dynamic links and traverse the stack E432| ; looking for the proper lex level to operate at. E432| ; Once the dynamic links are properly set up, E432| ; control is returned to the main procedure at E432| ; which point the p-code subroutine begins exec. E432| ;--------------------------------------------------- E432| 8D 03C0 CIP STA RDCARDRAM ; Read from p-code RAM. E435| A0 01 LDY #1 E437| B1 58 LDA @IPC,Y ; Get procedure number. E439| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E43C| 85 82 STA PROCNUM E43E| 20 62E2 JSR CALLUTIL ; Call utility routine. E441| E441| ; { Entry point from CXP } E441| 8D 03C0 LE441 STA RDCARDRAM ; Read from p-code RAM. E444| A0 09 LDY #9 E446| B1 86 LDA @P_A_TBL,Y E448| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E44B| 85 8E STA Z8E E44D| C6 8E DEC Z8E E44F| A5 52 LDA MP E451| 85 92 STA Z92 E453| A5 53 LDA MP+1 E455| 85 93 STA Z92+1 E457| 4C **** JMP $02 E45A| E45A| A0 02 $01 LDY #2 E45C| B1 92 LDA @Z92,Y E45E| AA TAX E45F| C8 INY E460| B1 92 LDA @Z92,Y E462| 85 93 STA Z92+1 E464| 86 92 STX Z92 E466| A0 04 $02 LDY #4 E468| B1 92 LDA @Z92,Y E46A| 85 96 STA Z96 E46C| C8 INY E46D| B1 92 LDA @Z92,Y E46F| 85 97 STA Z96+1 E471| A0 01 LDY #1 E473| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E476| B1 96 LDA @Z96,Y E478| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E47B| C5 8E CMP Z8E E47D| D0DB BNE $01 E47F| E47F| A0 02 LDY #2 E481| B1 92 LDA @Z92,Y E483| A0 00 LDY #0 E485| 91 52 STA @MP,Y E487| A0 03 LDY #3 E489| B1 92 LDA @Z92,Y E48B| A0 01 LDY #1 E48D| 91 52 STA @MP,Y E48F| 4C B4D2 JMP MAINLOOP E492| E492| E492| ;--------------------------------------------------- E492| ; CALL LOCAL PROCEDURE: CLP UB E492| ; Call proc number UB, which is an immediate child E492| ; of the currently executing proc and in the same E492| ; segment. The MSSTAT field (static link) of the E492| ; markstack is set to the value of the old MP reg. E492| ;--------------------------------------------------- E492| ; CLP (call local procedure) p-code: Fetches the E492| ; proc num from the code stream, calls the proc E492| ; invocation subroutine, patches the stack, and E492| ; returns control to the main interpreter loop for E492| ; execution of the p-code subroutine. E492| ;--------------------------------------------------- E492| 8D 03C0 CLP STA RDCARDRAM ; Read from p-code RAM. E495| A0 01 LDY #1 E497| B1 58 LDA @IPC,Y ; Get procedure number. E499| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E49C| 85 82 STA PROCNUM E49E| 20 62E2 JSR CALLUTIL ; Call utility routine. E4A1| A0 02 LDY #2 E4A3| B1 88 LDA @NEW_KP,Y E4A5| A0 00 LDY #0 E4A7| 91 88 STA @NEW_KP,Y E4A9| A0 03 LDY #3 E4AB| B1 88 LDA @NEW_KP,Y E4AD| A0 01 LDY #1 E4AF| 91 88 STA @NEW_KP,Y E4B1| 4C B4D2 JMP MAINLOOP E4B4| E4B4| E4B4| ;--------------------------------------------------- E4B4| ; CALL GLOBAL PROCEDURE: CGP UB E4B4| ; Call proc number UB, which is at lexical level 1 E4B4| ; and in the same segment as the currently executng E4B4| ; proc. The MSSTAT field (static link) of the E4B4| ; markstack is set to the value of the BASE reg. E4B4| ;--------------------------------------------------- E4B4| ; CGP (call global procedure) p-code: Identical to E4B4| ; CLP routine, except the BASE register is pushed E4B4| ; onto the stack in place of the normal dynamic E4B4| ; link. E4B4| ;--------------------------------------------------- E4B4| 8D 03C0 CGP STA RDCARDRAM ; Read from p-code RAM. E4B7| A0 01 LDY #1 E4B9| B1 58 LDA @IPC,Y ; Get procedure number. E4BB| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E4BE| 85 82 STA PROCNUM E4C0| 20 62E2 JSR CALLUTIL ; Call utility routine. E4C3| A0 00 LDY #0 E4C5| A5 50 LDA BASE E4C7| 91 88 STA @NEW_KP,Y E4C9| A5 51 LDA BASE+1 E4CB| C8 INY E4CC| 91 88 STA @NEW_KP,Y E4CE| 4C B4D2 JMP MAINLOOP E4D1| E4D1| E4D1| ;--------------------------------------------------- E4D1| ; CALL EXTERNAL PROCEDURE: CXP UB1,UB2 E4D1| ; Call proc number UB2, in segment UB1. Used to E4D1| ; any proc not in the same segment as the calling E4D1| ; proc, including base procs. If the desired seg E4D1| ; is not already in memory, it is read from disk. E4D1| ; Build an activation rec. Calculate the static E4D1| ; link for the markstack (if the called proc has E4D1| ; a lex level of -1 or 0, set as in the CBP E4D1| ; instruction; otherwise set as in CIP). E4D1| ;--------------------------------------------------- E4D1| ; CXP (call external procedure) p-code: Fetches two E4D1| ; parameters from the code stream. The 1st is the E4D1| ; procedure number, the 2nd the segment number. If E4D1| ; the segment number <> 0, a subroutine is called E4D1| ; to load the code from disk onto the program stack E4D1| ; (LOADSEG). Then the CXP utility routine is called E4D1| ; to set up the system for the procedure call. E4D1| ; Finally, the lex level is checked to see if <= 0. E4D1| ; If so, control goes to entry in CBP routine; E4D1| ; otherwise control goes to entry in CIP. E4D1| ;--------------------------------------------------- E4D1| 8D 03C0 CXP STA RDCARDRAM ; Read from p-code RAM. E4D4| A0 02 LDY #2 E4D6| B1 58 LDA @IPC,Y E4D8| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E4DB| 85 82 STA PROCNUM E4DD| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E4E0| A0 01 LDY #1 E4E2| B1 58 LDA @IPC,Y E4E4| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E4E7| 85 90 STA SEGNUM E4E9| F0** BEQ $01 E4EB| 20 **** JSR LOADSEG E4EE| E6 58 $01 INC IPC E4F0| D0** BNE CXP_1 E4F2| E6 59 INC IPC+1 E4F4| ; NOTE: Execution error code jumps here to restart (seg 0, proc 2) E4F4| 20 47E2 CXP_1 JSR CXPUTIL E4F7| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E4FA| A0 09 LDY #9 E4FC| B1 86 LDA @P_A_TBL,Y ; Get lex level. E4FE| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E501| F0** BEQ LE517 ; If <= 0, it's a E503| 30** BMI LE517 ; BASE procedure E505| 4C 41E4 JMP LE441 ; Else Normal procedure E508| E508| E508| ;--------------------------------------------------- E508| ; CALL BASE PROCEDURE: CBP UB E508| ; Call proc number UB, which is at lexical level -1 E508| ; or 0. The MSSTAT field (static link) of the E508| ; markstack is set to the MSSTAT field in the actvn E508| ; rec of the procedure pointed to by the BASE reg. E508| ; The value of the BASE reg is saved on the evalatn E508| ; stack, after which it is set to point to MSSTAT E508| ; field of the activation rec just created. E508| ;--------------------------------------------------- E508| ; CBP (call base procedure) p-code: Fetches the E508| ; procedure number and calls the procedure set-up E508| ; (just like the other calls), and then it pushes E508| ; a copy of the BASE register onto the 6502 stack. E508| ; Then it patches all the links in the activation E508| ; record so the static and dynamic links point at E508| ; the proper place. Finally, the stack pointer is E508| ; copied into the BASE register and control is E508| ; returned to the main interpreter loop. E508| ;--------------------------------------------------- E508| 8D 03C0 CBP STA RDCARDRAM ; Read from p-code RAM. E50B| A0 01 LDY #1 E50D| B1 58 LDA @IPC,Y E50F| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E512| 85 82 STA PROCNUM E514| 20 62E2 JSR CALLUTIL E517| E517| ; { Entry point from CXP } E517| A5 51 LE517 LDA BASE+1 E519| 48 PHA E51A| A5 50 LDA BASE E51C| 48 PHA E51D| BA TSX E51E| 8A TXA E51F| A0 0A LDY #10. E521| 91 88 STA @NEW_KP,Y E523| A0 00 LDY #0 E525| B1 50 LDA @BASE,Y E527| 91 88 STA @NEW_KP,Y E529| C8 INY E52A| B1 50 LDA @BASE,Y E52C| 91 88 STA @NEW_KP,Y E52E| A5 88 LDA NEW_KP E530| 85 50 STA BASE E532| 8D 2ABD STA STKBASE E535| A5 89 LDA NEW_KP+1 E537| 85 51 STA BASE+1 E539| 8D 2BBD STA STKBASE+1 E53C| 4C B4D2 JMP MAINLOOP E53F| E53F| E53F| ;--------------------------------------------------- E53F| ; RETURN FROM BASE PROCEDURE: RBP DB E53F| ; Move the value of the BASE register, saved on the E53F| ; evaluation stack by a CBP, back into the BASE reg, E53F| ; and then proceed as in the RNP instruction. E53F| ;--------------------------------------------------- E53F| ; RBP (return from base procedure) p-code: Get the E53F| ; pointer to the stack frome and load the SP reg E53F| ; with this value. Pop the BASE value off the stack E53F| ; and load into the BASE and temp BASE regs. Then E53F| ; jump to common code. E53F| ;--------------------------------------------------- E53F| A0 0A RBP LDY #10. E541| B1 52 LDA @MP,Y E543| AA TAX E544| 9A TXS E545| 68 PLA E546| 85 50 STA BASE E548| 8D 2ABD STA STKBASE E54B| 68 PLA E54C| 85 51 STA BASE+1 E54E| 8D 2BBD STA STKBASE+1 E551| 4C **** JMP LE55A E554| E554| E554| ;--------------------------------------------------- E554| ; RETURN FROM NONBASE PROCEDURE: RNP DB E554| ; DB is the number of words that should be returned E554| ; as the function value (0 for procedures, 1 for E554| ; nonreal functions, and 2 for real functions). Copy E554| ; DB words from the higher addresses of the current E554| ; procedure's activation record, and push them onto E554| ; the evalulation stack. Then copy the information E554| ; in the current proc's markstack fields into the E554| ; pseudoregisters to restore the calling proc's E554| ; correct environment. E554| ;--------------------------------------------------- E554| ; RNP (return from normal procedure) p-code: Reload E554| ; the 6502 stack pointer with the proper value and E554| ; fall through to the common code. E554| ;--------------------------------------------------- E554| A0 0A RNP LDY #10. E556| B1 52 LDA @MP,Y E558| AA TAX E559| 9A TXS E55A| E55A| ; Common code for RNP and RBP E55A| E55A| A5 52 LE55A LDA MP E55C| 38 SEC E55D| E9 04 SBC #4 E55F| 85 7E STA P_DICT E561| A5 53 LDA MP+1 E563| E9 00 SBC #0 E565| 85 7F STA P_DICT+1 E567| A0 00 LDY #0 E569| B1 7E LDA @P_DICT,Y E56B| 85 5E STA STRP E56D| C8 INY E56E| B1 7E LDA @P_DICT,Y E570| 85 5F STA STRP+1 E572| C8 INY E573| B1 7E LDA @P_DICT,Y E575| 85 5C STA KP E577| C8 INY E578| B1 7E LDA @P_DICT,Y E57A| 85 5D STA KP+1 E57C| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E57F| A0 01 LDY #1 E581| B1 58 LDA @IPC,Y ; Get # words to return. E583| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E586| F0** BEQ $02 E588| E588| 0A ASL A E589| 18 CLC E58A| 69 0B ADC #11. E58C| A8 TAY E58D| B1 52 $01 LDA @MP,Y ; Push functional E58F| 48 PHA ; return value E590| 88 DEY ; (if any) onto E591| B1 52 LDA @MP,Y ; the stack. E593| 48 PHA E594| 88 DEY E595| C0 0B CPY #11. E597| D0F4 BNE $01 E599| E599| A0 06 $02 LDY #6 E59B| B1 52 LDA @MP,Y E59D| 85 7E STA P_DICT E59F| C8 INY E5A0| B1 52 LDA @MP,Y E5A2| 85 7F STA P_DICT+1 E5A4| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E5A7| A0 00 LDY #0 E5A9| B1 56 LDA @SEG,Y E5AB| D1 7E CMP @P_DICT,Y E5AD| 8D 02C0 STA RDMAINRAM ; Read from main RAM. E5B0| F0** BEQ $03 E5B2| 20 **** JSR UNLOADSEG E5B5| A5 7E LDA P_DICT E5B7| 85 56 STA SEG E5B9| A5 7F LDA P_DICT+1 E5BB| 85 57 STA SEG+1 E5BD| A0 04 $03 LDY #4 E5BF| B1 52 LDA @MP,Y E5C1| 85 54 STA JTAB E5C3| C8 INY E5C4| B1 52 LDA @MP,Y E5C6| 85 55 STA JTAB+1 E5C8| A0 08 LDY #8 E5CA| B1 52 LDA @MP,Y E5CC| 85 58 STA IPC E5CE| C8 INY E5CF| B1 52 LDA @MP,Y E5D1| 85 59 STA IPC+1 E5D3| A0 03 LDY #3 E5D5| B1 52 LDA @MP,Y E5D7| AA TAX E5D8| 88 DEY E5D9| B1 52 LDA @MP,Y E5DB| 85 52 STA MP E5DD| 8D 2CBD STA LASTMP E5E0| 86 53 STX MP+1 E5E2| 8E 2DBD STX LASTMP+1 E5E5| 4C B4D2 JMP MAINLOOP E5E8| E5E8| E5E8| E5E8| E5E8| ;================================================================= E5E8| E5E8| .INCLUDE LOC1.3:SEGS1.3.TEXT E5E8| .PAGE E5E8| ;--------------------------------------------------- E5E8| ; Compute an address by subtracting the contents of E5E8| ; of loc $9A/9B from the word pointed at by that E5E8| ; word. The address computed is stored into the E5E8| ; procedure location variable at $86/87. E5E8| ;--------------------------------------------------- E5E8| A0 00 COMP_SR LDY #0 E5EA| 38 SEC E5EB| A5 9A LDA NXT_REF E5ED| F1 9A SBC @NXT_REF,Y E5EF| 85 86 STA REL_VAL E5F1| A5 9B LDA NXT_REF+1 E5F3| C8 INY E5F4| F1 9A SBC @NXT_REF,Y E5F6| 85 87 STA REL_VAL+1 E5F8| 60 RTS E5F9| E5F9| E5F9| ;--------------------------------------------------- E5F9| ; Relocation subroutine: The value contained in the E5F9| ; location pointed at by the procedure pointer is E5F9| ; fetched. This is the number of items to be E5F9| ; relocated. Next, two is subtracted from the E5F9| ; procedure pointer and this data is used as a E5F9| ; self-relative pointer to the relocation table. E5F9| ; For each item to be relocated, the data pointed E5F9| ; at by the self-relative pointer is relocated by E5F9| ; adding the relocation value to the value already E5F9| ; there. This process is repeated until the table E5F9| ; entries are exhausted. Every assembly language E5F9| ; program loaded into the system is relocated by E5F9| ; this routine at run time. E5F9| ;--------------------------------------------------- E5F9| A0 00 RELOC LDY #0 E5FB| B1 86 LDA @REL_VAL,Y E5FD| AA TAX E5FE| E8 INX E5FF| C8 INY E600| B1 86 LDA @REL_VAL,Y E602| 85 BA STA NUM_RELOC E604| 4C **** JMP $02 E607| E607| A0 00 $01 LDY #0 E609| 38 SEC E60A| A5 86 LDA REL_VAL E60C| F1 86 SBC @REL_VAL,Y E60E| 85 B8 STA ZB8 E610| C8 INY E611| A5 87 LDA REL_VAL+1 E613| F1 86 SBC @REL_VAL,Y E615| 85 B9 STA ZB8+1 E617| 18 CLC E618| 88 DEY E619| B1 B8 LDA @ZB8,Y E61B| 65 92 ADC Z92 E61D| 91 B8 STA @ZB8,Y E61F| C8 INY E620| B1 B8 LDA @ZB8,Y E622| 65 93 ADC Z92+1 E624| 91 B8 STA @ZB8,Y E626| 20 **** $02 JSR DEC_RV ; Bump to next word. E629| CA DEX E62A| D0DB BNE $01 E62C| E62C| C6 BA DEC NUM_RELOC E62E| 10D7 BPL $01 E630| E630| 60 RTS E631| E631| E631| ;--------------------------------------------------- E631| ; Increment NP 1 word if big disk in system E631| ;--------------------------------------------------- E631| AD 33BF INC_NP LDA DSK_FLG E634| 10** BPL $01 E636| E6 5B INC NP+1 E638| E6 5B INC NP+1 E63A| 60 $01 RTS E63B| E63B| E63B| E63B| ;--------------------------------------------------- E63B| ; Decrement NP 1 word if big disk in system E63B| ;--------------------------------------------------- E63B| AD 33BF DEC_NP LDA DSK_FLG E63E| 10** BPL $01 E640| C6 5B DEC NP+1 E642| C6 5B DEC NP+1 E644| 60 $01 RTS E645| E645| E645| ;--------------------------------------------------- E645| ; Check stack to see if there is room. E645| ;--------------------------------------------------- E645| A5 5C CHKSTK LDA KP E647| E5 5A SBC NP E649| A5 5D LDA KP+1 E64B| E5 5B SBC NP+1 E64D| B0** BCS $01 E64F| ; No room; try deallocating directory block. E64F| 20 BAD1 JSR CHKGDRP E652| 38 SEC E653| A5 5C LDA KP E655| E5 5A SBC NP E657| A5 5D LDA KP+1 E659| E5 5B SBC NP+1 E65B| 90** BCC LE67C ; Stack overflow! E65D| E65D| 60 $01 RTS E65E| E65E| E65E| ;--------------------------------------------------- E65E| ; Calculate free memory (multiple of 512 bytes). E65E| ;--------------------------------------------------- E65E| 20 31E6 CALC_FREE JSR INC_NP E661| 38 SEC E662| A5 5C LDA KP E664| E5 5A SBC NP E666| 85 88 STA NEW_KP E668| A5 5D LDA KP+1 E66A| E5 5B SBC NP+1 E66C| 85 89 STA NEW_KP+1 E66E| 20 3BE6 JSR DEC_NP E671| A9 00 LDA #0 E673| 85 88 STA NEW_KP E675| A5 89 LDA NEW_KP+1 E677| 29 FE AND #0FE E679| 85 89 STA NEW_KP+1 ; Return with E67B| 60 RTS ; # blocks in A. E67C| E67C| ; Execution error: stack overflow! E67C| 4C EDD1 LE67C JMP STKOVFL E67F| E67F| ; Execution error: code overflow! E67F| 4C 19D2 LE67F JMP CODEOVFL E682| E682| E682| 7EBD A_SEGTB1 .WORD SEG_TABLE E684| E684| ;--------------------------------------------------- E684| ; Read segment routine: reads the external segment E684| ; whose segment number is passed in the A-reg. The E684| ; segment directory is checked to find the drive and E684| ; block number for the routine. If the unit is on- E684| ; line, the BIOS DISKREAD routine is called. E684| ;--------------------------------------------------- E684| 85 7E READSEG STA P_DICT E686| 0A ASL A E687| 18 CLC E688| 65 7E ADC P_DICT E68A| 85 7E STA P_DICT E68C| A9 00 LDA #0 E68E| 85 7F STA P_DICT+1 E690| 06 7E ASL P_DICT E692| 26 7F ROL P_DICT+1 E694| 18 CLC E695| A5 7E LDA P_DICT E697| 6D 82E6 ADC A_SEGTB1 E69A| 85 40 STA Z40 E69C| A5 7F LDA P_DICT+1 E69E| 6D 83E6 ADC A_SEGTB1+1 E6A1| 85 41 STA Z40+1 E6A3| A0 00 LDY #0 E6A5| B1 40 LDA @Z40,Y E6A7| 85 7E STA P_DICT E6A9| A0 04 LDY #4 E6AB| B1 40 LDA @Z40,Y E6AD| 85 80 STA Z80 E6AF| C8 INY E6B0| B1 40 LDA @Z40,Y E6B2| 85 81 STA Z80+1 E6B4| A5 60 LDA CODEP E6B6| 38 SEC E6B7| E5 80 SBC Z80 E6B9| 85 60 STA CODEP E6BB| A5 61 LDA CODEP+1 E6BD| E5 81 SBC Z80+1 E6BF| 85 61 STA CODEP+1 E6C1| 90BC BCC LE67F ; Code overflow! E6C3| E6C3| A5 60 LDA CODEP E6C5| E5 62 SBC CODELOW E6C7| A5 61 LDA CODEP+1 E6C9| E5 63 SBC CODELOW+1 E6CB| 90B2 BCC LE67F ; Code overflow! E6CD| E6CD| A5 60 LDA CODEP E6CF| 85 8C STA S_NXTSEG E6D1| A5 61 LDA CODEP+1 E6D3| 85 8D STA S_NXTSEG+1 E6D5| A0 02 LDY #2 E6D7| B1 40 LDA @Z40,Y E6D9| 85 92 STA Z92 E6DB| C8 INY E6DC| B1 40 LDA @Z40,Y E6DE| 85 93 STA Z92+1 E6E0| A5 80 LDA Z80 E6E2| 85 8A STA Z8A E6E4| A5 81 LDA Z80+1 E6E6| 85 8B STA Z8A+1 E6E8| 20 5EE6 JSR CALC_FREE E6EB| D0** BNE $01 E6ED| E6ED| 20 BAD1 JSR CHKGDRP E6F0| 20 5EE6 JSR CALC_FREE E6F3| F087 BEQ LE67C ; Stack overflow! E6F5| E6F5| A5 8A $01 LDA Z8A E6F7| 85 98 STA S_RET E6F9| A5 8B LDA Z8A+1 E6FB| 85 99 STA S_RET+1 E6FD| A5 88 LDA NEW_KP E6FF| C5 8A CMP Z8A E701| A5 89 LDA NEW_KP+1 E703| E5 8B SBC Z8A+1 E705| B0** BCS $02 E707| E707| A5 88 LDA NEW_KP E709| 85 98 STA S_RET E70B| A5 89 LDA NEW_KP+1 E70D| 85 99 STA S_RET+1 E70F| A9 00 $02 LDA #0 ; Load driver params: E711| 48 PHA ; Mode = 0 E712| 48 PHA E713| E713| 48 PHA E714| A5 7E LDA P_DICT ; Unit number E716| 0A ASL A E717| A8 TAY E718| B9 **** LDA DISKNUM-1,Y E71B| F0** BEQ $03 E71D| C9 FF CMP #255. E71F| F0** BEQ $07 ; (Bad device type!) E721| A5 7E LDA P_DICT E723| 10** BPL $04 E725| B9 **** $03 LDA DISKNUM-2,Y E728| 48 $04 PHA E729| E729| 20 31E6 JSR INC_NP ; Buffer address E72C| A5 5B LDA NP+1 ; (heap) E72E| 48 PHA E72F| A5 5A LDA NP E731| 48 PHA E732| E732| 20 3BE6 JSR DEC_NP E735| A5 99 LDA S_RET+1 ; # of bytes E737| 48 PHA ; to read E738| A5 98 LDA S_RET E73A| 48 PHA E73B| E73B| A5 93 LDA Z92+1 ; Block number E73D| 48 PHA E73E| A5 92 LDA Z92 E740| 48 PHA E741| E741| B9 **** LDA DISKNUM-1,Y ; Check for E744| F0** BEQ $05 ; std driver. E746| E746| A5 7E LDA P_DICT ; A = unit #, E748| A2 00 LDX #0 ; X = "read", E74A| 20 **** JSR KPSUBD ; Call user driver. E74D| 4C **** JMP $06 E750| E750| 20 **** $05 JSR LFF12 ; Call DREAD. E753| E753| E0 00 $06 CPX #0 ; Check for E755| F0** BEQ $08 ; driver E757| 8E 1EBD STX IORSLT ; error. E75A| 4C 11D2 $07 JMP SYSIOERR E75D| E75D| 20 31E6 $08 JSR INC_NP ; Source address E760| A5 5A LDA NP ; of p-code is E762| 85 72 STA SOURCE ; heap. E764| A5 5B LDA NP+1 E766| 85 73 STA SOURCE+1 E768| 20 3BE6 JSR DEC_NP E76B| A5 8C LDA S_NXTSEG ; Dest address of p-code E76D| 85 74 STA DEST ; is code pointer + E76F| A5 8D LDA S_NXTSEG+1 ; previously read E771| 85 75 STA DEST+1 ; code. E773| E773| 8D 05C0 STA WRCARDRAM ; Write to p-code RAM. E776| E776| A6 99 LDX S_RET+1 E778| A0 00 LDY #0 E77A| E0 00 $09 CPX #0 E77C| F0** BEQ $11 E77E| CA DEX ; Move E77F| B1 72 $10 LDA @SOURCE,Y ; a E781| 91 74 STA @DEST,Y ; page E783| C8 INY ; of E784| D0F9 BNE $10 ; memory. E786| E6 75 INC DEST+1 ; Bump source & E788| E6 73 INC SOURCE+1 ; dest page #s. E78A| 4C 7AE7 JMP $09 E78D| E78D| A6 98 $11 LDX S_RET E78F| 4C **** JMP $13 E792| B1 72 $12 LDA @SOURCE,Y ; Move the E794| 91 74 STA @DEST,Y ; final, partial, E796| C8 INY ; page. E797| CA DEX E798| D0F8 $13 BNE $12 E79A| E79A| 8D 04C0 STA WRMAINRAM ; Write to main RAM. E79D| E79D| A5 8A LDA Z8A E79F| 38 SEC E7A0| E5 98 SBC S_RET E7A2| 85 8A STA Z8A E7A4| A5 8B LDA Z8A+1 E7A6| E5 99 SBC S_RET+1 E7A8| 85 8B STA Z8A+1 E7AA| D0** BNE $14 E7AC| E7AC| A5 8A LDA Z8A E7AE| F0** BEQ $16 ; Return to caller. E7B0| E7B0| A5 8C $14 LDA S_NXTSEG E7B2| 18 CLC E7B3| 65 98 ADC S_RET E7B5| 85 8C STA S_NXTSEG E7B7| A5 8D LDA S_NXTSEG+1 E7B9| 65 99 ADC S_RET+1 E7BB| 85 8D STA S_NXTSEG+1 E7BD| A5 99 LDA S_RET+1 E7BF| 4A LSR A E7C0| 18 CLC E7C1| 65 92 ADC Z92 E7C3| 85 92 STA Z92 E7C5| 90** BCC $15 E7C7| E6 93 INC Z92+1 E7C9| 4C F5E6 $15 JMP $01 E7CC| E7CC| 60 $16 RTS E7CD| E7CD| E7CD| ;--------------------------------------------------- E7CD| ; Load Segment subroutine: This subroutine is called E7CD| ; when it is necessary to load a segment from disk. E7CD| ; The segment number is passed in the A-reg. First, E7CD| ; the procedure call counter is checked. If = 0, E7CD| ; the segment procedure must be loaded from disk. E7CD| ; If not 0, this is a (possibly indirect) recursive E7CD| ; call and the proc is already in memory. If the E7CD| ; segment proc count is not 0, it is incremented by E7CD| ; 1 and the subroutine returns. E7CD| ;--------------------------------------------------- E7CD| 85 90 LOADSEG STA SEGNUM ; Save segment #. E7CF| 0A ASL A ; Double (word offset) E7D0| A8 TAY ; and use as index E7D1| B9 9EBB LDA SEG_CALL,Y ; into # calls table. E7D4| D0** BNE $01 E7D6| B9 9FBB LDA SEG_CALL+1,Y E7D9| F0** BEQ LE7E6 E7DB| ; Segment call entry <> 0. Just increment it. E7DB| 98 $01 TYA E7DC| AA TAX E7DD| FE 9EBB INC SEG_CALL,X E7E0| D0** BNE $02 E7E2| FE 9FBB INC SEG_CALL+1,X E7E5| 60 $02 RTS ; Return to caller. E7E6| E7E6| E7E6| ; Segment call entry = 0: it's not in memory. E7E6| A5 5C LE7E6 LDA KP ; Save current E7E8| 99 1EBC STA SEG_TOS,Y ; top-of-stack E7EB| A5 5D LDA KP+1 ; pointer. E7ED| 99 1FBC STA SEG_TOS+1,Y E7F0| A9 01 LDA #1 ; Set # calls E7F2| 99 9EBB STA SEG_CALL,Y ; entry to 1. E7F5| 98 TYA ; A = seg# * 2 E7F6| AA TAX ; X = seg# * 2 E7F7| 4A LSR A ; A = seg# E7F8| 85 7E STA P_DICT E7FA| 0A ASL A ; A = seg# * 2 E7FB| 18 CLC E7FC| 65 7E ADC P_DICT ; A = seg# * 3 E7FE| 85 7E STA P_DICT E800| A9 00 LDA #0 E802| 85 7F STA P_DICT+1 E804| 06 7E ASL P_DICT E806| 26 7F ROL P_DICT+1 ; $7E/7F = seg# * 6 E808| 18 CLC E809| A5 7E LDA P_DICT E80B| 6D 82E6 ADC A_SEGTB1 ; Add in table E80E| 85 40 STA Z40 ; address and E810| A5 7F LDA P_DICT+1 ; store in E812| 6D 83E6 ADC A_SEGTB1+1 ; $40/41. E815| 85 41 STA Z40+1 E817| A0 02 LDY #2 ; Index to block #. E819| B1 40 LDA @Z40,Y ; Get value from table. E81B| D0** BNE $02 E81D| C8 INY E81E| B1 40 LDA @Z40,Y E820| D0** BNE $02 E822| ; Block number is 0...this is a data segment! E822| A0 04 LDY #4 E824| 38 SEC ; Subtract length E825| A5 5C LDA KP ; from stack E827| F1 40 SBC @Z40,Y ; pointer. E829| 85 5C STA KP E82B| A5 5D LDA KP+1 E82D| C8 INY E82E| F1 40 SBC @Z40,Y E830| 85 5D STA KP+1 E832| 8A TXA E833| A8 TAY E834| 90** BCC $01 ; Stack overflow if KP < 0. E836| E836| 20 45E6 JSR CHKSTK ; Make sure there is room in memory. E839| A5 5C LDA KP ; Segment address E83B| 38 SEC ; = tos-2. E83C| E9 02 SBC #2 ; (NOTE: because this is a data E83E| 99 9EBC STA SEG_ADDR,Y ; segment, the address is in E841| A5 5D LDA KP+1 ; main, not auxillary, memory.) E843| E9 00 SBC #0 E845| 99 9FBC STA SEG_ADDR+1,Y E848| A6 90 LDX SEGNUM E84A| A9 00 LDA #0 ; Set segment type to 0 (data). E84C| 9D 5EBB STA SEG_TYPE,X E84F| 60 RTS E850| E850| 4C EDD1 $01 JMP STKOVFL E853| E853| 8A $02 TXA E854| A8 TAY E855| 38 SEC E856| A5 60 LDA CODEP E858| E9 02 SBC #2 E85A| 99 9EBC STA SEG_ADDR,Y E85D| 85 9A STA NXT_REF E85F| A5 61 LDA CODEP+1 E861| E9 00 SBC #0 E863| 99 9FBC STA SEG_ADDR+1,Y E866| 85 9B STA NXT_REF+1 E868| A5 90 LDA SEGNUM E86A| 20 84E6 JSR READSEG ; Read the segment E86D| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. E870| A9 FF LDA #255. E872| 85 8A STA Z8A E874| 85 8B STA Z8A+1 E876| A9 00 LDA #0 E878| 85 92 STA Z92 E87A| 85 93 STA Z92+1 E87C| A5 9A LDA NXT_REF E87E| 85 7E STA P_DICT E880| A5 9B LDA NXT_REF+1 E882| 85 7F STA P_DICT+1 E884| A0 01 LDY #1 E886| B1 9A LDA @NXT_REF,Y E888| 85 84 STA OLD_KP E88A| 38 SEC E88B| A5 60 LDA CODEP E88D| E5 84 SBC OLD_KP E88F| 85 8E STA Z8E E891| A5 61 LDA CODEP+1 E893| E9 00 SBC #0 E895| 85 8F STA Z8E+1 E897| 38 SEC E898| A5 8E LDA Z8E E89A| E5 62 SBC CODELOW E89C| A5 8F LDA Z8E+1 E89E| E5 63 SBC CODELOW+1 E8A0| B0** BCS $03 E8A2| 4C 7FE6 JMP LE67F ; Code overflow! E8A5| E8A5| A5 60 $03 LDA CODEP E8A7| 85 8E STA Z8E E8A9| A5 61 LDA CODEP+1 E8AB| 85 8F STA Z8E+1 E8AD| A5 8E LDA Z8E E8AF| 38 SEC E8B0| E9 01 SBC #1 E8B2| 85 8E STA Z8E E8B4| B0** BCS $04 E8B6| E8B6| C6 8F DEC Z8E+1 E8B8| A9 00 $04 LDA #0 E8BA| 85 80 STA Z80 E8BC| A9 02 LDA #2 E8BE| 85 81 STA Z80+1 E8C0| 8D 05C0 STA WRCARDRAM ; Write to p-code RAM. E8C3| 20 **** $05 JSR DEC_NR E8C6| 20 E8E5 JSR COMP_SR ; Compute self-reloc value. E8C9| A0 00 LDY #0 E8CB| B1 86 LDA @REL_VAL,Y E8CD| F0** BEQ $06 E8CF| E8CF| A5 90 LDA SEGNUM E8D1| F0** BEQ $09 E8D3| E8D3| A9 80 LDA #128. E8D5| 91 8E STA @Z8E,Y E8D7| D0** BNE $09 E8D9| E8D9| A5 86 $06 LDA REL_VAL E8DB| C5 8A CMP Z8A E8DD| A5 87 LDA REL_VAL+1 E8DF| E5 8B SBC Z8A+1 E8E1| B0** BCS $07 E8E3| E8E3| A5 86 LDA REL_VAL E8E5| 85 8A STA Z8A E8E7| A5 87 LDA REL_VAL+1 E8E9| 85 8B STA Z8A+1 E8EB| A5 86 $07 LDA REL_VAL E8ED| C5 92 CMP Z92 E8EF| A5 87 LDA REL_VAL+1 E8F1| E5 93 SBC Z92+1 E8F3| 90** BCC $08 E8F5| E8F5| A5 86 LDA REL_VAL E8F7| 85 92 STA Z92 E8F9| A5 87 LDA REL_VAL+1 E8FB| 85 93 STA Z92+1 E8FD| A0 01 $08 LDY #1 E8FF| B1 86 LDA @REL_VAL,Y E901| 88 DEY E902| 91 8E STA @Z8E,Y E904| A5 8E $09 LDA Z8E E906| 38 SEC E907| E9 01 SBC #1 E909| 85 8E STA Z8E E90B| B0** BCS $10 E90D| E90D| C6 8F DEC Z8E+1 E90F| C6 84 $10 DEC OLD_KP E911| D0B0 BNE $05 E913| E913| 8D 04C0 STA WRMAINRAM ; Write to main RAM. E916| A5 7E LDA P_DICT E918| 85 9A STA NXT_REF E91A| A5 7F LDA P_DICT+1 E91C| 85 9B STA NXT_REF+1 E91E| E91E| A9 FF LDA #255. E920| C5 8A CMP Z8A E922| D0** BNE $11 E924| C5 8B CMP Z8A+1 E926| D0** BNE $11 E928| 4C **** JMP LEC21 E92B| E92B| A5 8A $11 LDA Z8A E92D| 38 SEC E92E| E9 02 SBC #2 E930| 85 8A STA Z8A E932| B0** BCS $12 E934| C6 8B DEC Z8A+1 E936| A0 00 $12 LDY #0 E938| 38 SEC E939| A5 8A LDA Z8A E93B| F1 8A SBC @Z8A,Y E93D| AA TAX E93E| A5 8B LDA Z8A+1 E940| C8 INY E941| F1 8A SBC @Z8A,Y E943| 85 8B STA Z8A+1 E945| 86 8A STX Z8A E947| A5 92 LDA Z92 E949| 18 CLC E94A| 69 02 ADC #2 E94C| 85 92 STA Z92 E94E| 90** BCC $13 E950| E950| E6 93 INC Z92+1 E952| 38 $13 SEC E953| A5 92 LDA Z92 E955| E5 8A SBC Z8A E957| 85 8C STA S_NXTSEG E959| A5 93 LDA Z92+1 E95B| E5 8B SBC Z8A+1 E95D| 85 8D STA S_NXTSEG+1 E95F| 38 SEC E960| A5 5C LDA KP E962| E5 8C SBC S_NXTSEG E964| 85 5C STA KP E966| A5 5D LDA KP+1 E968| E5 8D SBC S_NXTSEG+1 E96A| 85 5D STA KP+1 E96C| 20 45E6 JSR CHKSTK ; Make sure there is room in memory. E96F| 38 SEC E970| A5 8A LDA Z8A E972| E5 60 SBC CODEP E974| 85 88 STA NEW_KP E976| A5 8B LDA Z8A+1 E978| E5 61 SBC CODEP+1 E97A| 85 89 STA NEW_KP+1 E97C| 38 SEC E97D| A5 5C LDA KP E97F| E5 88 SBC NEW_KP E981| 85 98 STA S_RET E983| A5 5D LDA KP+1 E985| E5 89 SBC NEW_KP+1 E987| 85 99 STA S_RET+1 E989| A0 01 LDY #1 E98B| B1 9A LDA @NXT_REF,Y E98D| 85 84 STA OLD_KP E98F| 20 **** JSR DEC_NR E992| 20 E8E5 JSR COMP_SR ; Compute self-reloc value. E995| A0 01 LDY #1 E997| B1 86 LDA @REL_VAL,Y E999| C9 01 CMP #1 E99B| B0** BCS $17 E99D| E99D| A5 86 LDA REL_VAL E99F| 38 SEC E9A0| E9 08 SBC #8 E9A2| 85 86 STA REL_VAL E9A4| B0** BCS $14 E9A6| C6 87 DEC REL_VAL+1 E9A8| 38 $14 SEC E9A9| A0 00 LDY #0 E9AB| A5 5C LDA KP E9AD| F1 86 SBC @REL_VAL,Y E9AF| 85 96 STA Z96 E9B1| C8 INY E9B2| A5 5D LDA KP+1 E9B4| F1 86 SBC @REL_VAL,Y E9B6| 85 97 STA Z96+1 E9B8| C8 INY E9B9| 38 SEC E9BA| A5 96 LDA Z96 E9BC| F1 86 SBC @REL_VAL,Y E9BE| 85 96 STA Z96 E9C0| B0** BCS $15 E9C2| C6 97 DEC Z96+1 E9C4| A5 96 $15 LDA Z96 E9C6| 38 SEC E9C7| E9 0C SBC #12. E9C9| 85 96 STA Z96 E9CB| B0** BCS $16 E9CD| C6 97 DEC Z96+1 E9CF| 4C **** $16 JMP LE9DA E9D2| E9D2| A5 50 $17 LDA BASE E9D4| 85 96 STA Z96 E9D6| A5 51 LDA BASE+1 E9D8| 85 97 STA Z96+1 E9DA| E9DA| 8D 05C0 LE9DA STA WRCARDRAM ; Write to p-code RAM. E9DD| 20 E8E5 JSR COMP_SR ; Compute self-reloc value. E9E0| A0 00 LDY #0 E9E2| B1 86 LDA @REL_VAL,Y E9E4| F0** BEQ $19 E9E6| 4C **** JMP $22 E9E9| E9E9| 20 **** $19 JSR DEC_RV ; Bump to next attribute. E9EC| B1 86 LDA @REL_VAL,Y E9EE| 18 CLC E9EF| 65 60 ADC CODEP E9F1| 85 88 STA NEW_KP E9F3| C8 INY E9F4| B1 86 LDA @REL_VAL,Y E9F6| 65 61 ADC CODEP+1 E9F8| 85 89 STA NEW_KP+1 E9FA| 88 DEY E9FB| 38 SEC E9FC| A5 88 LDA NEW_KP E9FE| E5 98 SBC S_RET EA00| 91 86 STA @REL_VAL,Y EA02| 91 80 STA @Z80,Y EA04| C8 INY EA05| A5 89 LDA NEW_KP+1 EA07| E5 99 SBC S_RET+1 EA09| 91 86 STA @REL_VAL,Y EA0B| 91 80 STA @Z80,Y EA0D| 88 DEY EA0E| 38 SEC EA0F| A5 86 LDA REL_VAL EA11| F1 86 SBC @REL_VAL,Y EA13| 85 94 STA Z94 EA15| C8 INY EA16| A5 87 LDA REL_VAL+1 EA18| F1 86 SBC @REL_VAL,Y EA1A| 85 95 STA Z94+1 EA1C| 20 **** JSR DEC_RV ; Bump to next attribute. EA1F| A0 05 LDY #5 EA21| B1 86 LDA @REL_VAL,Y EA23| F0** BEQ $20 EA25| EA25| 0A ASL A EA26| A8 TAY EA27| 8D 02C0 STA RDMAINRAM ; Read from main RAM. EA2A| B9 9EBC LDA SEG_ADDR,Y EA2D| 18 CLC EA2E| 69 02 ADC #2 EA30| 85 92 STA Z92 EA32| B9 9FBC LDA SEG_ADDR+1,Y EA35| 69 00 ADC #0 EA37| 85 93 STA Z92+1 EA39| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. EA3C| 4C **** JMP $21 EA3F| EA3F| EA3F| A5 96 $20 LDA Z96 EA41| 85 92 STA Z92 EA43| A5 97 LDA Z96+1 EA45| 85 93 STA Z92+1 EA47| EA47| 20 F9E5 $21 JSR RELOC ; Relocate the code. EA4A| A5 98 LDA S_RET EA4C| 85 92 STA Z92 EA4E| A5 99 LDA S_RET+1 EA50| 85 93 STA Z92+1 EA52| 20 F9E5 JSR RELOC ; Relocate the code. EA55| A5 94 LDA Z94 EA57| 85 92 STA Z92 EA59| A5 95 LDA Z94+1 EA5B| 85 93 STA Z92+1 EA5D| 20 F9E5 JSR RELOC ; Relocate the code. EA60| AD D7D1 LDA A_INTERP EA63| 85 92 STA Z92 EA65| AD D8D1 LDA A_INTERP+1 EA68| 85 93 STA Z92+1 EA6A| 20 F9E5 JSR RELOC ; Relocate the code. EA6D| EA6D| 20 **** $22 JSR DEC_NR EA70| A5 80 LDA Z80 EA72| 18 CLC EA73| 69 02 ADC #2 EA75| 85 80 STA Z80 EA77| 90** BCC $23 EA79| E6 81 INC Z80+1 EA7B| C6 84 $23 DEC OLD_KP EA7D| F0** BEQ $24 EA7F| EA7F| 4C DAE9 JMP LE9DA EA82| EA82| 8D 04C0 $24 STA WRMAINRAM ; Write to main RAM. EA85| A5 8A LDA Z8A EA87| 85 72 STA SOURCE EA89| A5 8B LDA Z8A+1 EA8B| 85 73 STA SOURCE+1 EA8D| A5 5C LDA KP EA8F| 85 74 STA DEST EA91| A5 5D LDA KP+1 EA93| 85 75 STA DEST+1 EA95| A6 8D LDX S_NXTSEG+1 EA97| A0 00 LDY #0 EA99| EA99| E0 00 $25 CPX #0 EA9B| F0** BEQ $27 EA9D| EA9D| CA DEX EA9E| B1 72 $26 LDA @SOURCE,Y EAA0| 91 74 STA @DEST,Y EAA2| C8 INY EAA3| D0F9 BNE $26 EAA5| EAA5| E6 75 INC DEST+1 EAA7| E6 73 INC SOURCE+1 EAA9| 4C 99EA JMP $25 EAAC| EAAC| A6 8C $27 LDX S_NXTSEG EAAE| 4C **** JMP $29 EAB1| B1 72 $28 LDA @SOURCE,Y EAB3| 91 74 STA @DEST,Y EAB5| C8 INY EAB6| CA DEX EAB7| D0F8 $29 BNE $28 EAB9| EAB9| A5 7E LDA P_DICT EABB| 85 9A STA NXT_REF EABD| A5 7F LDA P_DICT+1 EABF| 85 9B STA NXT_REF+1 EAC1| A0 01 LDY #1 EAC3| B1 9A LDA @NXT_REF,Y EAC5| 85 84 STA OLD_KP EAC7| A5 9A LDA NXT_REF EAC9| 38 SEC EACA| E5 84 SBC OLD_KP EACC| 85 9A STA NXT_REF EACE| B0** BCS $30 EAD0| C6 9B DEC NXT_REF+1 EAD2| A5 9A $30 LDA NXT_REF EAD4| 38 SEC EAD5| E5 84 SBC OLD_KP EAD7| 85 9A STA NXT_REF EAD9| B0** BCS $31 EADB| C6 9B DEC NXT_REF+1 EADD| A5 9A $31 LDA NXT_REF EADF| 85 86 STA REL_VAL EAE1| A5 9B LDA NXT_REF+1 EAE3| 85 87 STA REL_VAL+1 EAE5| 8D 05C0 STA WRCARDRAM ; Write to p-code RAM. EAE8| A5 8E $32 LDA Z8E EAEA| 18 CLC EAEB| 69 01 ADC #1 EAED| 85 8E STA Z8E EAEF| 90** BCC $33 EAF1| E6 8F INC Z8E+1 EAF3| A5 80 $33 LDA Z80 EAF5| 38 SEC EAF6| E9 02 SBC #2 EAF8| 85 80 STA Z80 EAFA| B0** BCS $34 EAFC| C6 81 DEC Z80+1 EAFE| A0 00 $34 LDY #0 EB00| B1 8E LDA @Z8E,Y EB02| 30** BMI $35 EB04| EB04| 20 **** JSR DEC_RV ; Bump to next attribute. EB07| A0 00 LDY #0 EB09| A9 00 LDA #0 EB0B| 91 86 STA @REL_VAL,Y EB0D| B1 8E LDA @Z8E,Y EB0F| C8 INY EB10| 91 86 STA @REL_VAL,Y EB12| 38 SEC EB13| A5 9A LDA NXT_REF EB15| E5 86 SBC REL_VAL EB17| 85 88 STA NEW_KP EB19| A5 9B LDA NXT_REF+1 EB1B| E5 87 SBC REL_VAL+1 EB1D| 85 89 STA NEW_KP+1 EB1F| 38 SEC EB20| A0 00 LDY #0 EB22| B1 9A LDA @NXT_REF,Y EB24| E5 88 SBC NEW_KP EB26| 85 92 STA Z92 EB28| C8 INY EB29| B1 9A LDA @NXT_REF,Y EB2B| E5 89 SBC NEW_KP+1 EB2D| 85 93 STA Z92+1 EB2F| A0 00 LDY #0 EB31| A5 88 LDA NEW_KP EB33| 91 9A STA @NXT_REF,Y EB35| C8 INY EB36| A5 89 LDA NEW_KP+1 EB38| 91 9A STA @NXT_REF,Y EB3A| 20 **** JSR DEC_RV ; Bump to next attribute. EB3D| A0 00 LDY #0 EB3F| B1 80 LDA @Z80,Y EB41| 18 CLC EB42| 65 92 ADC Z92 EB44| 91 86 STA @REL_VAL,Y EB46| C8 INY EB47| B1 80 LDA @Z80,Y EB49| 65 93 ADC Z92+1 EB4B| 91 86 STA @REL_VAL,Y EB4D| A5 9A $35 LDA NXT_REF EB4F| 18 CLC EB50| 69 02 ADC #2 EB52| 85 9A STA NXT_REF EB54| 90** BCC $36 EB56| E6 9B INC NXT_REF+1 EB58| C6 84 $36 DEC OLD_KP EB5A| F0** BEQ $37 EB5C| EB5C| 4C E8EA JMP $32 EB5F| EB5F| A5 8A $37 LDA Z8A EB61| 85 72 STA SOURCE EB63| A5 8B LDA Z8A+1 EB65| 85 73 STA SOURCE+1 EB67| A5 86 LDA REL_VAL EB69| 85 74 STA DEST EB6B| A5 87 LDA REL_VAL+1 EB6D| 85 75 STA DEST+1 EB6F| 38 SEC EB70| A5 72 LDA SOURCE EB72| E5 60 SBC CODEP EB74| 85 8C STA S_NXTSEG EB76| A5 73 LDA SOURCE+1 EB78| E5 61 SBC CODEP+1 EB7A| 85 8D STA S_NXTSEG+1 EB7C| 38 SEC EB7D| A5 74 LDA DEST EB7F| E5 72 SBC SOURCE EB81| 85 92 STA Z92 EB83| A5 75 LDA DEST+1 EB85| E5 73 SBC SOURCE+1 EB87| 85 93 STA Z92+1 EB89| A5 7E LDA P_DICT EB8B| 85 9A STA NXT_REF EB8D| A5 7F LDA P_DICT+1 EB8F| 85 9B STA NXT_REF+1 EB91| A0 01 LDY #1 EB93| B1 9A LDA @NXT_REF,Y EB95| 85 84 STA OLD_KP EB97| 20 **** LEB97 JSR DEC_NR EB9A| A0 00 LDY #0 EB9C| B1 8E LDA @Z8E,Y EB9E| 10** BPL $40 EBA0| EBA0| A0 00 LDY #0 EBA2| 38 SEC EBA3| B1 9A LDA @NXT_REF,Y EBA5| E5 92 SBC Z92 EBA7| 91 9A STA @NXT_REF,Y EBA9| C8 INY EBAA| B1 9A LDA @NXT_REF,Y EBAC| E5 93 SBC Z92+1 EBAE| 91 9A STA @NXT_REF,Y EBB0| A5 8E $40 LDA Z8E EBB2| 38 SEC EBB3| E9 01 SBC #1 EBB5| 85 8E STA Z8E EBB7| B0** BCS $41 EBB9| C6 8F DEC Z8E+1 EBBB| C6 84 $41 DEC OLD_KP EBBD| D0D8 BNE LEB97 EBBF| EBBF| A6 8D LDX Z8C+1 EBC1| E0 00 $42 CPX #0 EBC3| F0** BEQ $44 EBC5| EBC5| A0 FF LDY #255. EBC7| C6 73 DEC SOURCE+1 EBC9| C6 75 DEC DEST+1 EBCB| CA DEX EBCC| B1 72 $43 LDA @SOURCE,Y EBCE| 91 74 STA @DEST,Y EBD0| 88 DEY EBD1| D0F9 BNE $43 EBD3| EBD3| B1 72 LDA @SOURCE,Y EBD5| 91 74 STA @DEST,Y EBD7| 4C C1EB JMP $42 EBDA| EBDA| A4 8C $44 LDY Z8C EBDC| F0** BEQ $49 EBDE| EBDE| A5 72 LDA SOURCE EBE0| 38 SEC EBE1| E5 8C SBC Z8C EBE3| 85 72 STA SOURCE EBE5| B0** BCS $45 EBE7| C6 73 DEC SOURCE+1 EBE9| A5 74 $45 LDA DEST EBEB| 38 SEC EBEC| E5 8C SBC Z8C EBEE| 85 74 STA DEST EBF0| B0** BCS $46 EBF2| C6 75 DEC DEST+1 EBF4| A5 72 $46 LDA SOURCE EBF6| 38 SEC EBF7| E9 01 SBC #1 EBF9| 85 72 STA SOURCE EBFB| B0** BCS $47 EBFD| C6 73 DEC SOURCE+1 EBFF| A5 74 $47 LDA DEST EC01| 38 SEC EC02| E9 01 SBC #1 EC04| 85 74 STA DEST EC06| B0** BCS $48 EC08| C6 75 DEC DEST+1 EC0A| B1 72 $48 LDA @SOURCE,Y EC0C| 91 74 STA @DEST,Y EC0E| 88 DEY EC0F| D0F9 BNE $48 EC11| EC11| A5 60 $49 LDA CODEP EC13| 18 CLC EC14| 65 92 ADC Z92 EC16| 85 60 STA CODEP EC18| A5 61 LDA CODEP+1 EC1A| 65 93 ADC Z92+1 EC1C| 85 61 STA CODEP+1 EC1E| 8D 04C0 STA WRMAINRAM ; Write to main RAM. EC21| EC21| 8D 02C0 LEC21 STA RDMAINRAM ; Read from main RAM. EC24| A6 90 LDX SEGNUM EC26| A9 FF LDA #255. ; Set segment type to EC28| 9D 5EBB STA SEG_TYPE,X ; 255 (code segment). EC2B| 60 RTS EC2C| EC2C| EC2C| ;--------------------------------------------------- EC2C| ; Subroutine to decrement the Next Reference pointer. EC2C| ;--------------------------------------------------- EC2C| A5 9A DEC_NR LDA NXT_REF EC2E| 38 SEC EC2F| E9 02 SBC #2 EC31| 85 9A STA NXT_REF EC33| B0** BCS $01 EC35| C6 9B DEC NXT_REF+1 EC37| 60 $01 RTS EC38| EC38| EC38| ;--------------------------------------------------- EC38| ; Subroutine to decrement the Procedure Attribute EC38| ; Table pointer or Relocated Value by 2 (one word). EC38| ;--------------------------------------------------- EC38| DEC_PA EC38| A5 86 DEC_RV LDA REL_VAL EC3A| 38 SEC EC3B| E9 02 SBC #2 EC3D| 85 86 STA REL_VAL EC3F| B0** BCS $01 EC41| C6 87 DEC REL_VAL+1 EC43| 60 $01 RTS EC44| EC44| EC44| ;--------------------------------------------------- EC44| ; Unload a segment subroutine: de-allocates the EC44| ; space used by a segment procedure, then checks the EC44| ; proc counter. If not 0, some recursive invocation EC44| ; of the routine is outstanding and the code cannot EC44| ; be removed from memory. If = 0, the stack is fixed EC44| ; to de-allocate the space occupied by the proc. EC44| ;--------------------------------------------------- EC44| UNLOADSEG EC44| A8 TAY ; Y = seg # (byte index) EC45| 0A ASL A EC46| AA TAX ; X = seg# * 2 (word index) EC47| F0** BEQ $03 EC49| 38 SEC EC4A| BD 9EBB LDA SEG_CALL,X EC4D| E9 01 SBC #1 EC4F| 9D 9EBB STA SEG_CALL,X EC52| B0** BCS $01 EC54| DE 9FBB DEC SEG_CALL+1,X EC57| 60 RTS EC58| EC58| D0** $01 BNE $03 EC5A| BD 9FBB LDA SEG_CALL+1,X EC5D| D0** BNE $03 EC5F| B9 5EBB LDA SEG_TYPE,Y ; Get segment type. EC62| F0** BEQ $02 ; If 0, data segment. EC64| EC64| BD 9EBC LDA SEG_ADDR,X EC67| 18 CLC EC68| 69 02 ADC #2 EC6A| 85 60 STA CODEP EC6C| BD 9FBC LDA SEG_ADDR+1,X EC6F| 69 00 ADC #0 EC71| 85 61 STA CODEP+1 EC73| BD 1EBC $02 LDA SEG_TOS,X ; Restore EC76| 85 5C STA KP ; top-of-stack. EC78| BD 1FBC LDA SEG_TOS+1,X EC7B| 85 5D STA KP+1 EC7D| 60 $03 RTS EC7E| EC7E| EC7E| ;--------------------------------------------------- EC7E| ; LoadSegment CSP routine: Pops the segment number EC7E| ; into the A-reg, then calls the load segment EC7E| ; subroutine. Upon return from load segment, control EC7E| ; is returned to the main interpreter loop. EC7E| ;--------------------------------------------------- EC7E| 68 LDS PLA EC7F| AA TAX EC80| 68 PLA EC81| 8A TXA EC82| 20 CDE7 JSR LOADSEG EC85| 4C 88D2 JMP UPIPC2 EC88| EC88| EC88| ;--------------------------------------------------- EC88| ; UnloadSegment CPS routine: Pops the segment number EC88| ; into the A-reg, calls the unload segment routine, EC88| ; then returns control to the main interpreter loop. EC88| ;--------------------------------------------------- EC88| 68 ULS PLA EC89| AA TAX EC8A| 68 PLA EC8B| 8A TXA EC8C| 20 44EC JSR UNLOADSEG EC8F| 4C 88D2 JMP UPIPC2 EC92| EC92| EC92| ;--------------------------------------------------- EC92| ; CALL STANDARD PROCEDURE: CSP UB EC92| ; Used to call standard procedures built into the EC92| ; P-machine. EC92| ;--------------------------------------------------- EC92| ; CSP (call special procedure) p-code: Fetches the EC92| ; next byte from the code stream, multiplies it by EC92| ; two, and uses it as an index into the CSP table. EC92| ;--------------------------------------------------- EC92| 8D 03C0 CSP STA RDCARDRAM ; Read from p-code RAM. EC95| A0 01 LDY #1 EC97| B1 58 LDA @IPC,Y EC99| 8D 02C0 STA RDMAINRAM ; Read from main RAM. EC9C| 0A ASL A EC9D| 8D **** STA LECA0+1 ECA0| 6C 00D1 LECA0 JMP @CSPTBL ECA3| ECA3| ECA3| ECA3| ;================================================================= ECA3| ECA3| .INCLUDE LOC1.3:INTERP1.3D.TEXT ECA3| .PAGE ECA3| ;--------------------------------------------------- ECA3| ; FILLCHAR: CSP 10 ECA3| ;--------------------------------------------------- ECA3| ; FillChar CSP routine: expects the following on the ECA3| ; 6502 hardware stack: ECA3| ; Character <--SP ECA3| ; # of chars to fill ECA3| ; Index into array ECA3| ; Pointer to array base element ECA3| ; The character and # of chars are popoped. If the ECA3| ; number < 0, FillChar removes the other params and ECA3| ; terminates. Otherwise, the index and array base ECA3| ; pointer are popped and added. Next, the X-reg is ECA3| ; loaded with the number of pages to be filled with ECA3| ; the character and the routine enters a loop to ECA3| ; fill "X" pages. When the page count is zero, the ECA3| ; remaining bytes are filled by loading the X-reg ECA3| ; with the low order byte of the count value and ECA3| ; entering a second fill loop. ECA3| ;--------------------------------------------------- ECA3| 68 FLC PLA ECA4| AA TAX ; Save fill character. ECA5| 68 PLA ECA6| 68 PLA ; Save number ECA7| 85 68 STA FC_NUMCH ; of characters ECA9| 68 PLA ; parameter. ECAA| 85 69 STA FC_NUMCH+1 ECAC| 10** BPL $01 ECAE| 68 PLA ; If number ECAF| 68 PLA ; < 0, ECB0| 68 PLA ; pop params ECB1| 68 PLA ; and return. ECB2| 4C 88D2 JMP UPIPC2 ECB5| ECB5| 68 $01 PLA ; Get address ECB6| 85 74 STA FC_ADDR ; parameter. ECB8| 68 PLA ECB9| 85 75 STA FC_ADDR+1 ECBB| 18 CLC ; Add offset ECBC| 68 PLA ; parameter. ECBD| 65 74 ADC FC_ADDR ECBF| 85 74 STA FC_ADDR ECC1| 68 PLA ECC2| 65 75 ADC FC_ADDR+1 ECC4| 85 75 STA FC_ADDR+1 ECC6| ECC6| 8A TXA ; Put fill char in A. ECC7| A6 69 LDX FC_NUMCH+1 ; Put page number in X. ECC9| A0 00 LDY #0 ; Set up index for 256 stores. ECCB| ECCB| E0 00 $02 CPX #0 ; If page # = 0, ECCD| F0** BEQ $04 ; store the final partial page. ECCF| CA DEX ; Decrement page #. ECD0| 91 74 $03 STA @FC_ADDR,Y ; Store character ECD2| C8 INY ; into array ECD3| D0FB BNE $03 ; 256 times. ECD5| E6 75 INC FC_ADDR+1 ; Bump address by 256. ECD7| 4C CBEC JMP $02 ; Check for end. ECDA| ECDA| ; Done with full pages. Store the final partial page. ECDA| A6 68 $04 LDX FC_NUMCH ECDC| 4C **** JMP $06 ECDF| 91 74 $05 STA @FC_ADDR,Y ECE1| C8 INY ECE2| CA DEX ECE3| D0FA $06 BNE $05 ECE5| ECE5| 4C 88D2 JMP UPIPC2 ; Done with instruction. ECE8| ECE8| .PAGE ECE8| ;--------------------------------------------------- ECE8| ; SCAN: CSP 11 ECE8| ; tos is a two-byte quantity (usually the default ECE8| ; integer 0) that is pushed, but later discarded ECE8| ; without being used in this implementation. tos-1 ECE8| ; is a byte pointer to the first char to be scanned. ECE8| ; tos-2 is the char against which each scanned char ECE8| ; of the array is to be checked. tos-3 is 0 if the ECE8| ; check is for equality, or 1 if the check is for ECE8| ; inequality. tos-4 specifies the max number of ECE8| ; chars to be scanned (scan to the left if neg). If ECE8| ; a char check yields TRUE, push the num of chars ECE8| ; scanned (neg if scanning to left). If tos-4 chars ECE8| ; are scanned before char check yields TRUE, push ECE8| ; tos-4. ECE8| ;--------------------------------------------------- ECE8| ; Scan CSP routine: the address and index of the ECE8| ; source array are popped and added, the character ECE8| ; is fetched, a Boolean is popped, and the number ECE8| ; of characters to search is popped. The array is ECE8| ; searched (up to the specified number of chars) ECE8| ; for the character specified. If found, the ECE8| ; position in the array is returned. Otherwise the ECE8| ; original value is returned on the stack. ECE8| ;--------------------------------------------------- ECE8| 68 SCN PLA ECE9| 68 PLA ECEA| 68 PLA ECEB| 85 86 STA Z86 ECED| 68 PLA ECEE| 85 87 STA Z86+1 ECF0| 18 CLC ECF1| 68 PLA ECF2| 65 86 ADC Z86 ECF4| 85 86 STA Z86 ECF6| 85 8E STA Z8E ECF8| 68 PLA ECF9| 65 87 ADC Z86+1 ECFB| 85 87 STA Z86+1 ECFD| 85 8F STA Z8E+1 ECFF| 68 PLA ED00| 85 92 STA Z92 ED02| 68 PLA ED03| 68 PLA ED04| 85 94 STA Z94 ED06| 68 PLA ED07| 68 PLA ED08| 85 68 STA BIG ED0A| 18 CLC ED0B| 65 8E ADC Z8E ED0D| 85 8A STA Z8A ED0F| 68 PLA ED10| 85 69 STA BIG+1 ED12| 85 90 STA Z90 ED14| 65 8F ADC Z8E+1 ED16| 85 8B STA Z8A+1 ED18| 10** BPL $01 ED1A| ED1A| AA TAX ED1B| A5 68 LDA BIG ED1D| 49 FF EOR #0FF ED1F| 18 CLC ED20| 69 01 ADC #1 ED22| 85 68 STA BIG ED24| 8A TXA ED25| 49 FF EOR #0FF ED27| 69 00 ADC #0 ED29| 85 69 STA BIG+1 ED2B| A0 00 $01 LDY #0 ED2D| ED2D| B1 86 $02 LDA @Z86,Y ED2F| C5 92 CMP Z92 ED31| D0** BNE $03 ED33| A5 94 LDA Z94 ED35| F0** BEQ $07 ED37| 4C **** JMP $04 ED3A| ED3A| A5 94 $03 LDA Z94 ED3C| D0** BNE $07 ED3E| ED3E| A5 8A $04 LDA Z8A ED40| C5 86 CMP Z86 ED42| D0** BNE $05 ED44| ED44| A5 8B LDA Z8A+1 ED46| C5 87 CMP Z86+1 ED48| F0** BEQ $07 ED4A| ED4A| A5 90 $05 LDA Z90 ED4C| 30** BMI $06 ED4E| ED4E| E6 86 INC Z86 ED50| D0DB BNE $02 ED52| ED52| E6 87 INC Z86+1 ED54| 4C 2DED JMP $02 ED57| ED57| A5 86 $06 LDA Z86 ED59| 38 SEC ED5A| E9 01 SBC #1 ED5C| 85 86 STA Z86 ED5E| B0CD BCS $02 ED60| ED60| C6 87 DEC Z86+1 ED62| 4C 2DED JMP $02 ED65| ED65| A5 86 $07 LDA Z86 ED67| 38 SEC ED68| E5 8E SBC Z8E ED6A| AA TAX ED6B| A5 87 LDA Z86+1 ED6D| E5 8F SBC Z8E+1 ED6F| 48 PHA ED70| 8A TXA ED71| 48 PHA ED72| 4C 88D2 JMP UPIPC2 ED75| ED75| .PAGE ED75| ;--------------------------------------------------- ED75| ; EXIT: CSP 4 ED75| ; tos is the proc num, tos-1 is the seg num. First, ED75| ; set the MSIPC field to point to the exit code of ED75| ; the currently executing proc. ED75| ; If the current proc is not the one to exit from, ED75| ; change the MSIPC field of each markstack to point ED75| ; to the exit code of the proc that invoked it, ED75| ; until the desired proc is found. Then contine exec. ED75| ; If at any time the saved MSIPC field of the main ED75| ; body of the OS is to be changed, give an exec err. ED75| ;--------------------------------------------------- ED75| ; Exit CSP routine: pops a procedure and segment ED75| ; number. If this causes an exit from the OS, the ED75| ; XIT p-code routine is called. Otherwise, for ED75| ; each lex level being exited, the routine computes ED75| ; pointers to the activation for each statically ED75| ; nested procedure and readjusts the stack to ED75| ; remove the activation record for the procedure(s) ED75| ; being exited. ED75| ;--------------------------------------------------- ED75| 68 EXIT PLA ED76| 85 82 STA Z82 ED78| 68 PLA ED79| 68 PLA ED7A| 85 90 STA Z90 ED7C| 68 PLA ED7D| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. ED80| A0 01 LDY #1 ED82| B1 54 LDA @JTAB,Y ED84| 8D 02C0 STA RDMAINRAM ; Read from main RAM. ED87| 10** BPL $01 ED89| 4C 47D7 JMP XIT ED8C| ED8C| A5 54 $01 LDA JTAB ED8E| 38 SEC ED8F| E9 04 SBC #4 ED91| 85 7E STA Z7E ED93| A5 55 LDA JTAB+1 ED95| E9 00 SBC #0 ED97| 85 7F STA Z7E+1 ED99| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. ED9C| A0 00 LDY #0 ED9E| A5 7E LDA Z7E EDA0| 38 SEC EDA1| F1 7E SBC @Z7E,Y EDA3| 85 58 STA IPC EDA5| C8 INY EDA6| A5 7F LDA Z7E+1 EDA8| F1 7E SBC @Z7E,Y EDAA| 85 59 STA IPC+1 EDAC| 88 DEY EDAD| A5 82 LDA Z82 EDAF| D1 54 CMP @JTAB,Y EDB1| D0** BNE $02 EDB3| EDB3| A5 90 LDA Z90 EDB5| D1 56 CMP @SEG,Y EDB7| D0** BNE $02 EDB9| EDB9| 4C B4D2 JMP MAINLOOP EDBC| EDBC| 8D 02C0 $02 STA RDMAINRAM ; Read from main RAM. EDBF| A5 52 LDA MP EDC1| 85 92 STA Z92 EDC3| A5 53 LDA MP+1 EDC5| 85 93 STA Z92+1 EDC7| 4C **** JMP $04 EDCA| EDCA| A0 02 $03 LDY #2 EDCC| B1 92 LDA @Z92,Y EDCE| AA TAX EDCF| C8 INY EDD0| B1 92 LDA @Z92,Y EDD2| 85 93 STA Z92+1 EDD4| 86 92 STX Z92 EDD6| A0 04 $04 LDY #4 EDD8| B1 92 LDA @Z92,Y EDDA| 85 80 STA Z80 EDDC| C8 INY EDDD| B1 92 LDA @Z92,Y EDDF| 85 81 STA Z80+1 EDE1| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. EDE4| A0 01 LDY #1 EDE6| B1 80 LDA @Z80,Y EDE8| 8D 02C0 STA RDMAINRAM ; Read from main RAM. EDEB| 10** BPL $05 EDED| EDED| 4C E9D1 JMP EXUNCALL ; Execution error! EDF0| EDF0| A5 80 $05 LDA Z80 EDF2| 38 SEC EDF3| E9 04 SBC #4 EDF5| 85 80 STA Z80 EDF7| B0** BCS $06 EDF9| C6 81 DEC Z80+1 EDFB| A0 00 $06 LDY #0 EDFD| A5 80 LDA Z80 EDFF| 38 SEC EE00| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. EE03| F1 80 SBC @Z80,Y EE05| 8D 02C0 STA RDMAINRAM ; Read from main RAM. EE08| A0 08 LDY #8 EE0A| 91 92 STA @Z92,Y EE0C| A0 01 LDY #1 EE0E| A5 81 LDA Z80+1 EE10| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. EE13| F1 80 SBC @Z80,Y EE15| 8D 02C0 STA RDMAINRAM ; Read from main RAM. EE18| A0 09 LDY #9 EE1A| 91 92 STA @Z92,Y EE1C| A0 04 LDY #4 EE1E| A5 82 LDA Z82 EE20| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. EE23| D1 80 CMP @Z80,Y EE25| 8D 02C0 STA RDMAINRAM ; Read from main RAM. EE28| D0A0 $07 BNE $03 EE2A| EE2A| A0 06 LDY #6 EE2C| B1 92 LDA @Z92,Y EE2E| 85 7E STA Z7E EE30| C8 INY EE31| B1 92 LDA @Z92,Y EE33| 85 7F STA Z7E+1 EE35| A5 90 LDA Z90 EE37| A0 00 LDY #0 EE39| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. EE3C| D1 7E CMP @Z7E,Y EE3E| 8D 02C0 STA RDMAINRAM ; Read from main RAM. EE41| D0E5 BNE $07 EE43| EE43| 4C B4D2 JMP MAINLOOP EE46| EE46| EE46| ;--------------------------------------------------- EE46| ; BREAKPOINT: BPT B EE46| ;--------------------------------------------------- EE46| ; BreakPoint p-code: (not implemented) gets a EE46| ; BIG parameter from the code stream and returns EE46| ; to the main interpreter loop. EE46| ;--------------------------------------------------- EE46| A0 01 BPT LDY #1 EE48| 20 55D1 JSR GETBIG EE4B| 4C 88D2 JMP UPIPC2 EE4E| EE4E| EE4E| ;--------------------------------------------------- EE4E| ; HALT: CSP 39 EE4E| ;--------------------------------------------------- EE4E| ; Halt CSP routine: increments the program counter EE4E| ; by two and jumps to the user-invoked execution EE4E| ; error entry point. EE4E| ;--------------------------------------------------- EE4E| A5 58 HLT LDA IPC EE50| 18 CLC EE51| 69 02 ADC #2 EE53| 85 58 STA IPC EE55| 90** BCC $01 EE57| E6 59 INC IPC+1 EE59| 4C 0DD2 $01 JMP INTBYUSR EE5C| EE5C| EE5C| ;--------------------------------------------------- EE5C| ; TIME: CSP 9 EE5C| ;--------------------------------------------------- EE5C| ; Time CSP routine: (not implemented) stores zeroes EE5C| ; into the two parameters passed on the stack. EE5C| ;--------------------------------------------------- EE5C| 68 TIM PLA EE5D| 85 7E STA Z7E EE5F| 68 PLA EE60| 85 7F STA Z7E+1 EE62| 68 PLA EE63| 85 80 STA Z80 EE65| 68 PLA EE66| 85 81 STA Z80+1 EE68| A0 00 LDY #0 EE6A| A9 00 LDA #0 EE6C| 91 7E STA @Z7E,Y EE6E| 91 80 STA @Z80,Y EE70| C8 INY EE71| 91 7E STA @Z7E,Y EE73| 91 80 STA @Z80,Y EE75| 4C 88D2 JMP UPIPC2 EE78| EE78| .PAGE EE78| ;--------------------------------------------------- EE78| ; Code for MoveRight: performs a block move using EE78| ; decrementing pointers. EE78| ;--------------------------------------------------- EE78| A5 72 LEE78 LDA SOURCE EE7A| 18 CLC EE7B| 65 68 ADC BIG EE7D| 85 72 STA SOURCE EE7F| A5 73 LDA SOURCE+1 EE81| 65 69 ADC BIG+1 EE83| 85 73 STA SOURCE+1 EE85| A5 74 LDA DEST EE87| 18 CLC EE88| 65 68 ADC BIG EE8A| 85 74 STA DEST EE8C| A5 75 LDA DEST+1 EE8E| 65 69 ADC BIG+1 EE90| 85 75 STA DEST+1 EE92| A0 FF LDY #255. EE94| A6 69 LDX BIG+1 EE96| ; Jump address EE96| C6 73 $01 DEC SOURCE+1 EE98| C6 75 DEC DEST+1 EE9A| E0 00 CPX #0 EE9C| F0** BEQ $03 EE9E| EE9E| CA DEX EE9F| B1 72 $02 LDA @SOURCE,Y EEA1| 91 74 STA @DEST,Y EEA3| 88 DEY EEA4| C0 FF CPY #255. EEA6| D0F7 BNE $02 EEA8| EEA8| 4C 96EE JMP $01 EEAB| EEAB| EEAB| A6 68 $03 LDX BIG EEAD| 4C **** JMP $05 EEB0| B1 72 $04 LDA @SOURCE,Y EEB2| 91 74 STA @DEST,Y EEB4| 88 DEY EEB5| CA DEX EEB6| D0F8 $05 BNE $04 EEB8| EEB8| 4C 88D2 JMP UPIPC2 EEBB| EEBB| EEBB| ;--------------------------------------------------- EEBB| ; MOVELEFT: CSP 2 EEBB| ; MOVERIGHT: CSP 3 EEBB| ; Tos specifies the number of bytes to move. tos-1 EEBB| ; is a byte pointer to the first destination byte. EEBB| ; tos-2 is a byte pointer to the first source byte. EEBB| ; Copy tos bytes from the source to the destinating. EEBB| ;--------------------------------------------------- EEBB| ; MoveLeft and MoveRight CSP routines: pops the EEBB| ; requiured parameters off the stack, then EEBB| ; determines which move routine to call. EEBB| ;--------------------------------------------------- EEBB| MVR EEBB| 68 MVL PLA EEBC| 85 68 STA BIG EEBE| 68 PLA EEBF| 85 69 STA BIG+1 EEC1| 30** BMI LEF1A EEC3| EEC3| 68 PLA EEC4| 85 74 STA DEST EEC6| 68 PLA EEC7| 85 75 STA DEST+1 EEC9| 18 CLC EECA| 68 PLA EECB| 65 74 ADC DEST EECD| 85 74 STA DEST EECF| 68 PLA EED0| 65 75 ADC DEST+1 EED2| 85 75 STA DEST+1 EED4| 68 PLA EED5| 85 72 STA SOURCE EED7| 68 PLA EED8| 85 73 STA SOURCE+1 EEDA| 18 CLC EEDB| 68 PLA EEDC| 65 72 ADC SOURCE EEDE| 85 72 STA SOURCE EEE0| 68 PLA EEE1| 65 73 ADC SOURCE+1 EEE3| 85 73 STA SOURCE+1 EEE5| 8D 03C0 STA RDCARDRAM ; Read from p-code RAM. EEE8| A0 01 LDY #1 EEEA| B1 58 LDA @IPC,Y EEEC| 8D 02C0 STA RDMAINRAM ; Read from main RAM. EEEF| C9 02 CMP #2 EEF1| D085 BNE LEE78 ; Move right. EEF3| EEF3| ;--------------------------------------------------- EEF3| ; Code for MoveLeft: performs a block move using EEF3| ; incrementing pointers. EEF3| ;--------------------------------------------------- EEF3| EEF3| A6 69 DOMOV LDX BIG+1 ; Entry point from MOV p-code. EEF5| A0 00 LDY #0 EEF7| E0 00 LEEF7 CPX #0 EEF9| F0** BEQ $03 EEFB| EEFB| CA DEX EEFC| B1 72 $02 LDA @SOURCE,Y EEFE| 91 74 STA @DEST,Y EF00| C8 INY EF01| D0F9 BNE $02 EF03| E6 75 INC DEST+1 EF05| E6 73 INC SOURCE+1 EF07| 4C F7EE JMP LEEF7 EF0A| EF0A| A6 68 $03 LDX BIG EF0C| 4C **** JMP $05 EF0F| EF0F| B1 72 $04 LDA @SOURCE,Y EF11| 91 74 STA @DEST,Y EF13| C8 INY EF14| CA DEX EF15| D0F8 $05 BNE $04 EF17| EF17| 4C 88D2 JMP UPIPC2 EF1A| EF1A| EF1A| ; Just pop the parameters and return. EF1A| EF1A| 68 LEF1A PLA EF1B| 68 PLA EF1C| 68 PLA EF1D| 68 PLA EF1E| 68 PLA EF1F| 68 PLA EF20| 68 PLA EF21| 68 PLA EF22| 4C 88D2 JMP UPIPC2 EF25| EF25| EF25| ;--------------------------------------------------- EF25| ; MEMAVAIL: CSP 40 EF25| ;--------------------------------------------------- EF25| ; MemAvail CSP routine: Return the number of words EF25| ; available on the program stack. EF25| ;--------------------------------------------------- EF25| 38 MEMAV SEC EF26| AD 27BD LDA GDIRP+1 EF29| F0** BEQ $01 EF2B| A5 5C LDA KP EF2D| ED 26BD SBC GDIRP EF30| AA TAX EF31| A5 5D LDA KP+1 EF33| ED 27BD SBC GDIRP+1 EF36| 4C **** JMP $02 EF39| A5 5C $01 LDA KP EF3B| E5 5A SBC NP EF3D| AA TAX EF3E| A5 5D LDA KP+1 EF40| E5 5B SBC NP+1 EF42| 4A $02 LSR A EF43| 48 PHA EF44| 8A TXA EF45| 6A ROR A EF46| 48 PHA EF47| 4C 88D2 JMP UPIPC2 EF4A| EF4A| EF4A| EF4A| ;================================================================= EF4A| EF4A| .INCLUDE LOC1.3:FLOAT1.3.TEXT EF4A| .PAGE EF4A| ;--------------------------------------------------- EF4A| ; Floating point pop EF4A| ; Utility subroutine which pops a floating point EF4A| ; number off the stack and unpacks it. The X-reg EF4A| ; points at one of three floating point work EF4A| ; areas. This routine stores the unpacked data EF4A| ; into the area pointed to by the X-register. EF4A| ;--------------------------------------------------- EF4A| 68 POPFL PLA ; Save the EF4B| 85 92 STA F_RETN ; return EF4D| 68 PLA ; address. EF4E| 85 93 STA F_RETN+1 EF50| EF50| ; Clear the necessary work area bytes. EF50| A9 00 LDA #0. EF52| 95 05 STA F_MANT4,X EF54| 95 00 STA F_SIGN,X EF56| 95 01 STA F_EXP,X EF58| EF58| ; Move the flt pt number from stack to work area. EF58| 68 PLA ; 1st byte is EF59| 95 04 STA F_MANT3,X ; end of mantissa. EF5B| EF5B| 68 PLA ; 2nd byte is EF5C| 95 03 STA F_MANT2,X ; middle of mantissa. EF5E| EF5E| 68 PLA ; 3rd bytes contains EF5F| 2A ROL A ; 1 bit of exponent EF60| 36 01 ROL F_EXP,X ; plus rest of EF62| 38 SEC ; mantissa. EF63| 6A ROR A EF64| 95 02 STA F_MANT1,X EF66| EF66| 68 PLA ; 4th byte contains EF67| 18 CLC ; sign and rest of EF68| 2A ROL A ; exponent EF69| 76 00 ROR F_SIGN,X EF6B| 15 01 ORA F_EXP,X EF6D| 95 01 STA F_EXP,X EF6F| EF6F| E6 92 INC F_RETN ; Return EF71| D0** BNE $54 ; to EF73| E6 93 INC F_RETN+1 ; caller. EF75| 6C 9200 $54 JMP @F_RETN EF78| EF78| EF78| ;--------------------------------------------------- EF78| ; Floating point push routine EF78| ; Performs the opposite function of the pop EF78| ; routine. It takes the floating point work area EF78| ; pointed to by the X-register, packs it, and EF78| ; pushes the packed result onto the eval. stack. EF78| ;--------------------------------------------------- EF78| 68 PUSHFL PLA ; Save EF79| 85 92 STA F_RETN ; return EF7B| 68 PLA ; address. EF7C| 85 93 STA F_RETN+1 EF7E| EF7E| B5 01 LDA F_EXP,X ; Pack together EF80| 18 CLC ; sign and EF81| 6A ROR A ; exponent. EF82| 15 00 ORA F_SIGN,X EF84| 48 PHA EF85| EF85| B5 02 LDA F_MANT1,X ; Pack together EF87| 2A ROL A ; 1 bit of exponent EF88| 76 01 ROR F_EXP,X ; and high order EF8A| 6A ROR A ; of mantissa. EF8B| 48 PHA EF8C| EF8C| B5 03 LDA F_MANT2,X ; Push EF8E| 48 PHA ; rest EF8F| B5 04 LDA F_MANT3,X ; of EF91| 48 PHA ; mantissa. EF92| EF92| E6 92 INC F_RETN ; Return EF94| D0** BNE $77 ; to EF96| E6 93 INC F_RETN+1 ; caller EF98| 6C 9200 $77 JMP @F_RETN EF9B| EF9B| ;--------------------------------------------------- EF9B| ; Bump exponent routine EF9B| ; Called within the REAL addition and multiplcn EF9B| ; routines. If the carry is set, then the number EF9B| ; is shifted to the right and the exponent is EF9B| ; bumped up by one. EF9B| ;--------------------------------------------------- EF9B| 90** BUMPEX BCC F_GOBK ; Done if carry is clear. EF9D| EF9D| 66 8C ROR FPWORK3+F_MANT1 ; Rotate EF9F| 66 8D ROR FPWORK3+F_MANT2 ; mantissa EFA1| 66 8E ROR FPWORK3+F_MANT3 ; right EFA3| 66 8F ROR FPWORK3+F_MANT4 ; 1 bit. EFA5| EFA5| 90** BCC $01 ; If bit was shifted out, EFA7| EFA7| A9 01 LDA #1 ; Make sure l.s.b. EFA9| 05 8F ORA FPWORK3+F_MANT4 ; of mantissa is EFAB| 85 8F STA FPWORK3+F_MANT4 ; set. EFAD| EFAD| E6 8B $01 INC FPWORK3+F_EXP ; Bump exponent. EFAF| EFAF| A9 FF LDA #255. ; If exponent EFB1| C5 8B CMP FPWORK3+F_EXP ; is in range, EFB3| D0** BNE F_GOBK ; return! EFB5| EFB5| ; >> ERROR! Exponent cannot fit in 8 bits! EFB5| 68 PLA ; Remove return EFB6| 68 PLA ; address. EFB7| 4C 29D2 JMP FLPTERR ; Transfer to flt pt error EFBA| EFBA| ; Return to caller! EFBA| 60 F_GOBK RTS EFBB| EFBB| EFBB| ;--------------------------------------------------- EFBB| ; FP Normalize routine EFBB| ; After any floating point operation the value EFBB| ; must be normalized. This is accomplished by EFBB| ; shifting the mantissa to the left until a one EFBB| ; appears in the h.o. bit. Each time the mantissa EFBB| ; is shifted the exponent is decremented by one. EFBB| ;--------------------------------------------------- EFBB| A5 8C NORMLZE LDA FPWORK3+F_MANT1 ; If high-order bit of EFBD| 30** BMI RTS2 ; mantissa set, return. EFBF| EFBF| 18 CLC ; Shift EFC0| 26 8F ROL FPWORK3+F_MANT4 ; mantissa EFC2| 26 8E $01 ROL FPWORK3+F_MANT3 ; right. EFC4| 26 8D ROL FPWORK3+F_MANT2 EFC6| 26 8C ROL FPWORK3+F_MANT1 EFC8| 30** BMI $02 ; If high-order bit EFCA| 18 CLC ; is not set, EFCB| C6 8B DEC FPWORK3+F_EXP ; dec exponent EFCD| D0F3 BNE $01 ; (chk underflow) EFCF| F0** BEQ BAD ; and shift again. EFD1| EFD1| ; High order bit set in mantissa! EFD1| C6 8B $02 DEC FPWORK3+F_EXP ; Do final decrement. EFD3| D0** BNE RTS2 ; Check underflow. EFD5| EFD5| ; >> ERROR! Exponent cannot fit in 8 bits! EFD5| 68 BAD PLA ; Remove return EFD6| 68 PLA ; address. EFD7| 4C 29D2 JMP FLPTERR ; Transfer to flt pt error EFDA| EFDA| 60 RTS2 RTS EFDB| EFDB| EFDB| ;--------------------------------------------------- EFDB| ; Round routine EFDB| ; Rounds the floating point value in the third EFDB| ; floating point work area. If a number lies EFDB| ; exactly between two representable values, then EFDB| ; it is rounded to the value with the l.s.b. of 0. EFDB| ;--------------------------------------------------- EFDB| 18 ROUND CLC EFDC| 26 8F ROL FPWORK3+F_MANT4 ; If guard byte MSB = 0, EFDE| 90** BCC RTS3 ; all done! EFE0| EFE0| E6 8E INC FPWORK3+F_MANT3 ; Increment EFE2| D0** BNE $01 ; mantissa EFE4| E6 8D INC FPWORK3+F_MANT2 ; by 1 EFE6| D0** BNE $01 ; (with EFE8| E6 8C INC FPWORK3+F_MANT1 ; carry). EFEA| EFEA| A5 8F $01 LDA FPWORK3+F_MANT4 ; Get guard byte. EFEC| D0** BNE $02 ; If zero, EFEE| 46 8E LSR FPWORK3+F_MANT3 ; clear l.s.b. EFF0| 06 8E ASL FPWORK3+F_MANT3 ; of mantissa. EFF2| EFF2| ; Set/clear carry bit based upon mantissa byte 1. EFF2| A5 8C $02 LDA FPWORK3+F_MANT1 EFF4| 18 CLC EFF5| D0** BNE RTS3 EFF7| 38 SEC EFF8| EFF8| ; Return to caller EFF8| 60 RTS3 RTS EFF9| EFF9| ;--------------------------------------------------- EFF9| ; FP Adjust routine EFF9| ; When adding or subtracting two floating point EFF9| ; values, the exponents must be the same. This EFF9| ; routine scales the values in floating point work EFF9| ; work areas one and two so that they have the EFF9| ; same exponent. This is accomplished by shifting EFF9| ; the smaller value to the right and incrementing EFF9| ; its exponent. EFF9| ;--------------------------------------------------- EFF9| A5 7F ADJUST LDA FPWORK1+F_EXP EFFB| 85 8B STA FPWORK3+F_EXP EFFD| 38 SEC EFFE| E5 85 SBC FPWORK2+F_EXP F000| B0** BCS $03 F002| 49 FF EOR #255. F004| AA TAX F005| E8 INX F006| A5 85 LDA FPWORK2+F_EXP F008| 85 8B STA FPWORK3+F_EXP F00A| 46 80 $01 LSR FPWORK1+F_MANT1 F00C| 66 81 ROR FPWORK1+F_MANT2 F00E| 66 82 ROR FPWORK1+F_MANT3 F010| 66 83 ROR FPWORK1+F_MANT4 F012| 90** BCC $02 F014| A9 01 LDA #1 F016| 05 83 ORA FPWORK1+F_MANT4 F018| 85 83 STA FPWORK1+F_MANT4 F01A| CA $02 DEX F01B| D0ED BNE $01 F01D| F0** $03 BEQ RTS4 F01F| AA TAX F020| 46 86 $04 LSR FPWORK2+F_MANT1 F022| 66 87 ROR FPWORK2+F_MANT2 F024| 66 88 ROR FPWORK2+F_MANT3 F026| 66 89 ROR FPWORK2+F_MANT4 F028| 90** BCC $05 F02A| A9 01 LDA #1 F02C| 05 89 ORA FPWORK2+F_MANT4 F02E| 85 89 STA FPWORK2+F_MANT4 F030| CA $05 DEX F031| D0ED BNE $04 F033| 60 RTS4 RTS F034| F034| ;--------------------------------------------------- F034| ; FP addition subroutine F034| ; Aligns the values in FP work areas one and two, F034| ; adds the mantissas, normalizes the result, F034| ; rounds the result, and finally re-normalizes the F034| ; result. F034| ;--------------------------------------------------- F034| 20 F9EF ADDFL JSR ADJUST ; Make exponents match. F037| F037| 18 CLC ; Add the mantissas. F038| A5 83 LDA FPWORK1+F_MANT4 F03A| 65 89 ADC FPWORK2+F_MANT4 F03C| 85 8F STA FPWORK3+F_MANT4 F03E| A5 82 LDA FPWORK1+F_MANT3 F040| 65 88 ADC FPWORK2+F_MANT3 F042| 85 8E STA FPWORK3+F_MANT3 F044| A5 81 LDA FPWORK1+F_MANT2 F046| 65 87 ADC FPWORK2+F_MANT2 F048| 85 8D STA FPWORK3+F_MANT2 F04A| A5 80 LDA FPWORK1+F_MANT1 F04C| 65 86 ADC FPWORK2+F_MANT1 F04E| 85 8C STA FPWORK3+F_MANT1 F050| F050| 20 9BEF JSR BUMPEX ; Normalize. F053| 20 DBEF JSR ROUND ; Round. F056| 20 9BEF JSR BUMPEX ; Normalize. F059| F059| 60 RTS ; Return. F05A| F05A| F05A| ;--------------------------------------------------- F05A| ; FP Subtraction subroutine F05A| ; Aligns, subtracts, normalizes, and rounds two F05A| ; floating point numbers. F05A| ;--------------------------------------------------- F05A| 20 F9EF SUBFL JSR ADJUST ; Allign exponents F05D| F05D| 38 SEC ; Subtract mantissas F05E| A5 89 LDA FPWORK2+F_MANT4 F060| E5 83 SBC FPWORK1+F_MANT4 F062| 85 8F STA FPWORK3+F_MANT4 F064| A5 88 LDA FPWORK2+F_MANT3 F066| E5 82 SBC FPWORK1+F_MANT3 F068| 85 8E STA FPWORK3+F_MANT3 F06A| A5 87 LDA FPWORK2+F_MANT2 F06C| E5 81 SBC FPWORK1+F_MANT2 F06E| 85 8D STA FPWORK3+F_MANT2 F070| A5 86 LDA FPWORK2+F_MANT1 F072| E5 80 SBC FPWORK1+F_MANT1 F074| 85 8C STA FPWORK3+F_MANT1 F076| F076| A5 8C LDA FPWORK3+F_MANT1 ; Check for F078| D0** BNE NOT0 ; mantissa = 0. F07A| A5 8D LDA FPWORK3+F_MANT2 F07C| D0** BNE NOT0 F07E| A5 8E LDA FPWORK3+F_MANT3 F080| D0** BNE NOT0 F082| F082| ; Result of subtraction was 0. F082| A9 00 LDA #0 ; Make sure F084| 85 8B STA FPWORK3+F_EXP ; exponent is 0. F086| 85 8A STA FPWORK3 F088| 60 RTS ; Return to user. F089| F089| ; Result was not zero. F089| 20 BBEF NOT0 JSR NORMLZE ; Normalize result. F08C| 20 DBEF JSR ROUND ; Round it. F08F| 20 9BEF JSR BUMPEX ; Normalize. F092| F092| 60 RTS ; Return to caller. F093| F093| F093| ;--------------------------------------------------- F093| ; FP compare and swap routine F093| ; Compares the absolute values of the floating F093| ; point numbers in the FP work areas one and two. F093| ; If #1 > #2, they are swapped and the carry F093| ; is cleared. Otherwise the carry is returned set. F093| ;--------------------------------------------------- F093| A5 7F C_S_FL LDA FPWORK1+F_EXP ; Compare exponents. F095| C5 85 CMP FPWORK2+F_EXP F097| 90** BCC LESS_EQ F099| D0** BNE GREATER F09B| F09B| ; Exponents equal...keep comparing until different. F09B| A5 80 LDA FPWORK1+F_MANT1 ; Compare mantissas. F09D| C5 86 CMP FPWORK2+F_MANT1 F09F| 90** BCC LESS_EQ F0A1| D0** BNE GREATER F0A3| A5 81 LDA FPWORK1+F_MANT2 F0A5| C5 87 CMP FPWORK2+F_MANT2 F0A7| 90** BCC LESS_EQ F0A9| D0** BNE GREATER F0AB| A5 82 LDA FPWORK1+F_MANT3 F0AD| C5 88 CMP FPWORK2+F_MANT3 F0AF| 90** BCC LESS_EQ F0B1| D0** BNE GREATER F0B3| A5 83 LDA FPWORK1+F_MANT4 F0B5| C5 89 CMP FPWORK2+F_MANT4 F0B7| 90** BCC LESS_EQ F0B9| D0** BNE GREATER F0BB| F0BB| ; 1st value is <= second F0BB| A5 84 LESS_EQ LDA FPWORK2+F_SIGN ; A-reg = sign. F0BD| 38 SEC ; Set carry. F0BE| 60 RTS ; Return to caller. F0BF| F0BF| ; 1st value is > second F0BF| A6 7F GREATER LDX FPWORK1+F_EXP ; Swap exponents. F0C1| A4 85 LDY FPWORK2+F_EXP F0C3| 84 7F STY FPWORK1+F_EXP F0C5| 86 85 STX FPWORK2+F_EXP F0C7| F0C7| A6 80 LDX FPWORK1+F_MANT1 ; Swap mantissas. F0C9| A4 86 LDY FPWORK2+F_MANT1 F0CB| 84 80 STY FPWORK1+F_MANT1 F0CD| 86 86 STX FPWORK2+F_MANT1 F0CF| F0CF| A6 81 LDX FPWORK1+F_MANT2 F0D1| A4 87 LDY FPWORK2+F_MANT2 F0D3| 84 81 STY FPWORK1+F_MANT2 F0D5| 86 87 STX FPWORK2+F_MANT2 F0D7| F0D7| A6 82 LDX FPWORK1+F_MANT3 F0D9| A4 88 LDY FPWORK2+F_MANT3 F0DB| 84 82 STY FPWORK1+F_MANT3 F0DD| 86 88 STX FPWORK2+F_MANT3 F0DF| F0DF| A5 7E LDA FPWORK1+F_SIGN ; A-reg = sign. F0E1| 18 CLC ; Clear carry. F0E2| 60 RTS ; Return to caller. F0E3| F0E3| F0E3| ;--------------------------------------------------- F0E3| ; ADD REAL: ADR F0E3| ; Add tos and tos-1, and push resulting sum. F0E3| ;--------------------------------------------------- F0E3| ; ADR (add REAL) p-code routine F0E3| ; Pops two floating point numbers off the stack F0E3| ; and adds them. If the signs are different, the F0E3| ; subtraction routine is called instead. F0E3| ;--------------------------------------------------- F0E3| A2 7E ADR LDX #FPWORK1 ; Pop value into work F0E5| 20 4AEF JSR POPFL ; area # 1. F0E8| F0E8| A2 84 LDX #FPWORK2 ; Pop value into work F0EA| 20 4AEF JSR POPFL ; area # 2. F0ED| F0ED| A5 7F LDA FPWORK1+F_EXP ; If value # 1 is 0, F0EF| D0** BNE $01 F0F1| A2 84 LDX #FPWORK2 ; push value # 2 F0F3| 20 78EF JSR PUSHFL ; onto stack. F0F6| 4C AED2 JMP UPIPC1 ; Return to Pascal. F0F9| F0F9| A5 85 $01 LDA FPWORK2+F_EXP ; If value # 2 is 0, F0FB| D0** BNE $02 F0FD| A2 7E LDX #FPWORK1 ; push value # 1 F0FF| 20 78EF JSR PUSHFL ; onto stack. F102| 4C AED2 JMP UPIPC1 ; Return to Pascal. F105| F105| A5 7E $02 LDA FPWORK1+F_SIGN ; If signs match: F107| 45 84 EOR FPWORK2+F_SIGN F109| D0** BNE $03 F10B| A5 7E LDA FPWORK1+F_SIGN ; Set sign of result. F10D| 85 8A STA FPWORK3+F_SIGN F10F| 20 34F0 JSR ADDFL ; Add the numbers. F112| A2 8A LDX #FPWORK3 ; Push result F114| 20 78EF JSR PUSHFL ; onto stack. F117| 4C AED2 JMP UPIPC1 ; Return to Pascal. F11A| F11A| ; (Signs don't match) F11A| 20 93F0 $03 JSR C_S_FL ; Swap operands. F11D| 85 8A STA FPWORK3+F_SIGN ; Set sign of result. F11F| 20 5AF0 JSR SUBFL ; Subtract the numbers. F122| A2 8A LDX #FPWORK3 ; Push result onto stack. F124| 20 78EF JSR PUSHFL F127| 4C AED2 JMP UPIPC1 ; Return to Pascal. F12A| F12A| ;--------------------------------------------------- F12A| ; SUBTRACT REALS: SBR F12A| ; Subtract tos from tos-1 and push the difference. F12A| ;--------------------------------------------------- F12A| ; SBR (subtract REAL) p-code routine. F12A| ; Two floating point numbers are popped off of the F12A| ; stack and the FP subtract routine is called. If F12A| ; the signs are different, the add routine is F12A| ; called instead. F12A| ;--------------------------------------------------- F12A| A2 7E SBR LDX #FPWORK1 ; Pop value into work F12C| 20 4AEF JSR POPFL ; area # 1. F12F| F12F| A2 84 LDX #FPWORK2 ; Pop value into work F131| 20 4AEF JSR POPFL ; area # 2. F134| F134| A5 7F LDA FPWORK1+F_EXP ; If value # 1 is 0, F136| D0** BNE $01 F138| A2 84 LDX #FPWORK2 ; push value # 2 F13A| 20 78EF JSR PUSHFL ; onto stack. F13D| 4C AED2 JMP UPIPC1 ; Return to Pascal. F140| F140| A5 85 $01 LDA FPWORK2+F_EXP ; If value # 2 is 0, F142| D0** BNE $02 F144| A5 7E LDA FPWORK1+F_SIGN F146| 49 80 EOR #080 F148| 85 7E STA FPWORK1+F_SIGN F14A| A2 7E LDX #FPWORK1 ; push value # 1 F14C| 20 78EF JSR PUSHFL ; onto stack. F14F| 4C AED2 JMP UPIPC1 ; Return to Pascal. F152| F152| A5 7E $02 LDA FPWORK1+F_SIGN ; If signs match: F154| 45 84 EOR FPWORK2+F_SIGN F156| F0** BEQ $03 F158| A5 84 LDA FPWORK2+F_SIGN ; Set sign of result. F15A| 85 8A STA FPWORK3+F_SIGN F15C| 20 34F0 JSR ADDFL ; Add the numbers. F15F| A2 8A LDX #FPWORK3 ; Push result F161| 20 78EF JSR PUSHFL ; onto stack. F164| 4C AED2 JMP UPIPC1 ; Return to Pascal. F167| F167| ; (Signs don't match) F167| 20 93F0 $03 JSR C_S_FL ; Swap operands. F16A| B0** BCS $04 F16C| 49 80 EOR #080 F16E| 85 8A $04 STA FPWORK3+F_SIGN ; Set sign of result. F170| 20 5AF0 JSR SUBFL ; Subtract the numbers. F173| A2 8A LDX #FPWORK3 ; Push result onto stack. F175| 20 78EF JSR PUSHFL F178| 4C AED2 JMP UPIPC1 ; Return to Pascal. F17B| F17B| F17B| ;--------------------------------------------------- F17B| ; DIVIDE REALS: DVR F17B| ; Divide tos-1 by tos and push the quotient. F17B| ;--------------------------------------------------- F17B| ; DVR (Divide REAL) p-code: Pops two floating point F17B| ; values into the work area. Checks the 1st value F17B| ; for 0 and if so forces an execution error. If the F17B| ; other value = 0, then 0 is pushed and control F17B| ; returns to the main loop. If neither number was F17B| ; 0, the two exponents are subtracted to determine F17B| ; the exponent of the result. If underflow occurs, F17B| ; an error is forced. Otherwise the FPWA#2 is F17B| ; divided by the FPWA#1 and the result is returned F17B| ; on the evaluation stack. F17B| ;--------------------------------------------------- F17B| A2 7E DVR LDX #FPWORK1 F17D| 20 4AEF JSR POPFL F180| A2 84 LDX #FPWORK2 F182| 20 4AEF JSR POPFL F185| A5 7F LDA FPWORK1+F_EXP F187| D0** BNE $01 F189| F189| 4C 09D2 JMP DIVBY0 ; Execution error! F18C| F18C| A5 85 $01 LDA FPWORK2+F_EXP F18E| D0** BNE $02 F190| A9 00 LDA #0 F192| 48 PHA F193| 48 PHA F194| 48 PHA F195| 48 PHA F196| 4C AED2 JMP UPIPC1 F199| F199| A5 7E $02 LDA FPWORK1+F_SIGN F19B| 45 84 EOR FPWORK2+F_SIGN F19D| 85 8A STA FPWORK3+F_SIGN F19F| F19F| A5 85 LDA FPWORK2+F_EXP F1A1| 38 SEC F1A2| E5 7F SBC FPWORK1+F_EXP F1A4| 90** BCC $03 F1A6| 18 CLC F1A7| 69 7F ADC #127. F1A9| B0** BCS $04 ; Execution error! F1AB| C9 FF CMP #255. F1AD| F0** BEQ $04 ; Execution error! F1AF| 90** BCC $05 F1B1| 69 7F $03 ADC #127. F1B3| F0** BEQ $04 ; Execution error! F1B5| 10** BPL $05 F1B7| 4C 29D2 $04 JMP FLPTERR ; Execution error! F1BA| F1BA| 85 8B $05 STA FPWORK3+F_EXP F1BC| A2 20 LDX #32. F1BE| 38 $06 SEC F1BF| A5 89 LDA FPWORK2+F_MANT4 F1C1| E5 83 SBC FPWORK1+F_MANT4 F1C3| 85 91 STA FP_TEMP+1 F1C5| A5 88 LDA FPWORK2+F_MANT3 F1C7| E5 82 SBC FPWORK1+F_MANT3 F1C9| 85 90 STA FP_TEMP F1CB| A5 87 LDA FPWORK2+F_MANT2 F1CD| E5 81 SBC FPWORK1+F_MANT2 F1CF| A8 TAY F1D0| A5 86 LDA FPWORK2+F_MANT1 F1D2| E5 80 SBC FPWORK1+F_MANT1 F1D4| 90** BCC $07 F1D6| F1D6| 85 86 STA FPWORK2+F_MANT1 F1D8| 84 87 STY FPWORK2+F_MANT2 F1DA| A5 90 LDA FP_TEMP F1DC| 85 88 STA FPWORK2+F_MANT3 F1DE| A5 91 LDA FP_TEMP+1 F1E0| 85 89 STA FPWORK2+F_MANT4 F1E2| 38 SEC F1E3| 26 8F $07 ROL FPWORK3+F_MANT4 F1E5| 26 8E ROL FPWORK3+F_MANT3 F1E7| 26 8D ROL FPWORK3+F_MANT2 F1E9| 26 8C ROL FPWORK3+F_MANT1 F1EB| 46 80 LSR FPWORK1+F_MANT1 F1ED| 66 81 ROR FPWORK1+F_MANT2 F1EF| 66 82 ROR FPWORK1+F_MANT3 F1F1| 66 83 ROR FPWORK1+F_MANT4 F1F3| CA DEX F1F4| D0C8 BNE $06 F1F6| F1F6| 20 BBEF JSR NORMLZE F1F9| 20 DBEF JSR ROUND F1FC| 20 9BEF JSR BUMPEX F1FF| A2 8A LDX #FPWORK3 F201| 20 78EF JSR PUSHFL F204| 4C AED2 JMP UPIPC1 F207| F207| F207| ;--------------------------------------------------- F207| ; FP multiplication subroutine: multiply FPWA#1 by F207| ; FPWA#2 and leave result in FPWA#3. F207| ;--------------------------------------------------- F207| A5 7E FPMUL LDA FPWORK1+F_SIGN F209| 45 84 EOR FPWORK2+F_SIGN F20B| 85 8A STA FPWORK3+F_SIGN F20D| A5 7F LDA FPWORK1+F_EXP F20F| 38 SEC F210| E9 7F SBC #127. F212| 85 7F STA FPWORK1+F_EXP F214| A5 85 LDA FPWORK2+F_EXP F216| 38 SEC F217| E9 7F SBC #127. F219| B8 CLV F21A| 18 CLC F21B| 65 7F ADC FPWORK1+F_EXP F21D| 50** BVC $02 F21F| F21F| 68 $01 PLA F220| 68 PLA F221| 4C 29D2 JMP FLPTERR ; Execution error! F224| 18 $02 CLC F225| 69 7F ADC #127. F227| F0F6 BEQ $01 ; Execution error! F229| C9 FF CMP #255. F22B| F0F2 BEQ $01 ; Execution error! F22D| F22D| 85 8B STA FPWORK3+F_EXP F22F| A9 00 LDA #0 F231| 85 8C STA FPWORK3+F_MANT1 F233| 85 8D STA FPWORK3+F_MANT2 F235| 85 8E STA FPWORK3+F_MANT3 F237| 85 8F STA FPWORK3+F_MANT4 F239| A2 18 LDX #24. F23B| F23B| 46 80 $03 LSR FPWORK1+F_MANT1 F23D| 66 81 ROR FPWORK1+F_MANT2 F23F| 66 82 ROR FPWORK1+F_MANT3 F241| 90** BCC $04 F243| F243| 18 CLC F244| A5 8E LDA FPWORK3+F_MANT3 F246| 65 88 ADC FPWORK2+F_MANT3 F248| 85 8E STA FPWORK3+F_MANT3 F24A| A5 8D LDA FPWORK3+F_MANT2 F24C| 65 87 ADC FPWORK2+F_MANT2 F24E| 85 8D STA FPWORK3+F_MANT2 F250| A5 8C LDA FPWORK3+F_MANT1 F252| 65 86 ADC FPWORK2+F_MANT1 F254| 85 8C STA FPWORK3+F_MANT1 F256| CA $04 DEX F257| F0** BEQ $05 F259| F259| 66 8C ROR FPWORK3+F_MANT1 F25B| 66 8D ROR FPWORK3+F_MANT2 F25D| 66 8E ROR FPWORK3+F_MANT3 F25F| 66 8F ROR FPWORK3+F_MANT4 F261| 90D8 BCC $03 F263| F263| A5 8F LDA FPWORK3+F_MANT4 F265| 09 01 ORA #1 F267| 85 8F STA FPWORK3+F_MANT4 F269| 4C 3BF2 JMP $03 F26C| F26C| 20 9BEF $05 JSR BUMPEX F26F| 20 DBEF JSR ROUND F272| 20 9BEF JSR BUMPEX F275| 60 RTS F276| F276| F276| ;--------------------------------------------------- F276| ; MULTIPLY REALS: MPR F276| ; Multiply tos and tos-1 and push the product. F276| ;--------------------------------------------------- F276| ; MPR (multiply REALs) p-code: Pops two floating F276| ; point values, calls the FP multiplication routine, F276| ; then pushes FPWA#3 onto the evaluation stack. F276| ;--------------------------------------------------- F276| A2 7E MPR LDX #FPWORK1 F278| 20 4AEF JSR POPFL F27B| A2 84 LDX #FPWORK2 F27D| 20 4AEF JSR POPFL F280| A5 7F LDA FPWORK1+F_EXP F282| F0** BEQ $01 F284| A5 85 LDA FPWORK2+F_EXP F286| F0** BEQ $01 F288| D0** BNE $02 F28A| F28A| A9 00 $01 LDA #0 F28C| 48 PHA F28D| 48 PHA F28E| 48 PHA F28F| 48 PHA F290| 4C AED2 JMP UPIPC1 F293| F293| 20 07F2 $02 JSR FPMUL F296| A2 8A LDX #FPWORK3 F298| 20 78EF JSR PUSHFL F29B| 4C AED2 JMP UPIPC1 F29E| F29E| F29E| ;--------------------------------------------------- F29E| ; SQUARE REALS: SQR F29E| ; Square tos, and push the result. F29E| ;--------------------------------------------------- F29E| ; SQR (square REALs) p-code: checks the REAL F29E| ; number on TOS; if = 0, return a zero. Otherwise, F29E| ; the data on TOS is duplicated in FPWA#1 and #2, F29E| ; the FP multiply routine is called, and FPWA#3 is F29E| ; pushed onto the evaluation stack. F29E| ;--------------------------------------------------- F29E| A2 7E SQR LDX #FPWORK1 F2A0| 20 4AEF JSR POPFL F2A3| A5 7F LDA FPWORK1+F_EXP F2A5| D0** BNE $01 F2A7| F2A7| A9 00 LDA #0 F2A9| 48 PHA F2AA| 48 PHA F2AB| 48 PHA F2AC| 48 PHA F2AD| 4C AED2 JMP UPIPC1 F2B0| F2B0| A5 7E $01 LDA FPWORK1+F_SIGN F2B2| 85 84 STA FPWORK2+F_SIGN F2B4| A5 7F LDA FPWORK1+F_EXP F2B6| 85 85 STA FPWORK2+F_EXP F2B8| A5 80 LDA FPWORK1+F_MANT1 F2BA| 85 86 STA FPWORK2+F_MANT1 F2BC| A5 81 LDA FPWORK1+F_MANT2 F2BE| 85 87 STA FPWORK2+F_MANT2 F2C0| A5 82 LDA FPWORK1+F_MANT3 F2C2| 85 88 STA FPWORK2+F_MANT3 F2C4| A5 83 LDA FPWORK1+F_MANT4 F2C6| 85 89 STA FPWORK2+F_MANT4 F2C8| 20 07F2 JSR FPMUL F2CB| A2 8A LDX #FPWORK3 F2CD| 20 78EF JSR PUSHFL F2D0| 4C AED2 JMP UPIPC1 F2D3| F2D3| F2D3| ;--------------------------------------------------- F2D3| ; ABSOLUTE VALUE OF REAL: ABR F2D3| ; Push the absolute value of the real tos. F2D3| ;--------------------------------------------------- F2D3| ; ABR (absolute value of REAL number) p-code: F2D3| ; clears the H.O. bit of the exponent byte by F2D3| ; shifting it left and then right. F2D3| ;--------------------------------------------------- F2D3| BA ABR TSX F2D4| E8 INX F2D5| E8 INX F2D6| E8 INX F2D7| E8 INX F2D8| 1E 0001 ASL STACK,X F2DB| 5E 0001 LSR STACK,X F2DE| 4C AED2 JMP UPIPC1 F2E1| F2E1| F2E1| ;--------------------------------------------------- F2E1| ; NEGATE REAL: NGR F2E1| ; Negate the real tos, and push the result. F2E1| ;--------------------------------------------------- F2E1| ; NGR (Negate REAL) p-code: inverts the sign bit F2E1| ; in the exponent byte. F2E1| ;--------------------------------------------------- F2E1| BA NGR TSX F2E2| BD 0301 LDA STACK+3,X F2E5| 85 7E STA FPWORK1+F_SIGN F2E7| BD 0401 LDA STACK+4,X F2EA| 85 80 STA FPWORK1+F_MANT1 F2EC| 26 7E ROL FPWORK1+F_SIGN F2EE| 26 80 ROL FPWORK1+F_MANT1 F2F0| F0** BEQ $01 F2F2| F2F2| E8 INX F2F3| E8 INX F2F4| E8 INX F2F5| E8 INX F2F6| BD 0001 LDA STACK,X F2F9| 49 80 EOR #128. F2FB| 9D 0001 STA STACK,X F2FE| 4C AED2 $01 JMP UPIPC1 F301| F301| F301| ;--------------------------------------------------- F301| ; Float integer value subroutine: an integer value F301| ; is on TOS. Pop it and convert to floating point. F301| ; The result is left in FPWA#3. F301| ;--------------------------------------------------- F301| 68 FLOATI PLA F302| 85 92 STA F_RETN F304| 68 PLA F305| 85 93 STA F_RETN+1 F307| F307| 68 PLA F308| 85 90 STA FP_TEMP F30A| 68 PLA F30B| 85 91 STA FP_TEMP+1 F30D| F30D| A5 91 LDA FP_TEMP+1 F30F| D0** BNE $01 F311| A5 90 LDA FP_TEMP F313| D0** BNE $01 F315| 85 8A STA FPWORK3+F_SIGN F317| 85 8B STA FPWORK3+F_EXP F319| 85 8C STA FPWORK3+F_MANT1 F31B| 85 8D STA FPWORK3+F_MANT2 F31D| 85 8E STA FPWORK3+F_MANT3 F31F| F0** BEQ $04 ; Return to caller. F321| F321| A9 00 $01 LDA #0 F323| 85 8A STA FPWORK3+F_SIGN F325| A2 8E LDX #142. F327| A5 91 LDA FP_TEMP+1 F329| 10** BPL $02 F32B| F32B| A9 80 LDA #128. F32D| 85 8A STA FPWORK3+F_SIGN F32F| 18 CLC F330| A5 90 LDA FP_TEMP F332| 49 FF EOR #255. F334| 69 01 ADC #1 F336| 85 90 STA FP_TEMP F338| A5 91 LDA FP_TEMP+1 F33A| 49 FF EOR #255. F33C| 69 00 ADC #0 F33E| 85 91 STA FP_TEMP+1 F340| 30** BMI $03 F342| F342| CA $02 DEX F343| 06 90 ASL FP_TEMP F345| 26 91 ROL FP_TEMP+1 F347| 10F9 BPL $02 F349| F349| 86 8B $03 STX FPWORK3+F_EXP F34B| A5 91 LDA FP_TEMP+1 F34D| 85 8C STA FPWORK3+F_MANT1 F34F| A5 90 LDA FP_TEMP F351| 85 8D STA FPWORK3+F_MANT2 F353| A9 00 LDA #0 F355| 85 8E STA FPWORK3+F_MANT3 F357| E6 92 $04 INC F_RETN F359| D0** BNE $05 F35B| F35B| E6 93 INC F_RETN+1 F35D| 6C 9200 $05 JMP @F_RETN F360| F360| F360| ;--------------------------------------------------- F360| ; FLOAT NEXT TO TOP-OF-STACK: FLO F360| ; tos is a real, tos-1 is an integer. Convert tos-1 F360| ; to a real number, and push the result. F360| ;--------------------------------------------------- F360| ; FLO (float integer) p-code: floats the integer F360| ; value on TOS-1. It accomplishes this by popping F360| ; 4 bytes off TOS (there is always a REAL on TOS) F360| ; and saving it in FPWA#1. Then a call to the float F360| ; routine is made to float the integer left on TOS. F360| ; Finally, the floating point value saved in FPWA#1 F360| ; is pushed back onto the stack and the code returns F360| ; to the main interpreter loop. F360| ;--------------------------------------------------- F360| 68 FLO PLA F361| 85 83 STA FPWORK1+F_MANT4 F363| 68 PLA F364| 85 82 STA FPWORK1+F_MANT3 F366| 68 PLA F367| 85 81 STA FPWORK1+F_MANT2 F369| 68 PLA F36A| 85 80 STA FPWORK1+F_MANT1 F36C| F36C| 20 01F3 JSR FLOATI F36F| F36F| A2 8A LDX #FPWORK3 F371| 20 78EF JSR PUSHFL F374| F374| A5 80 LDA FPWORK1+F_MANT1 F376| 48 PHA F377| A5 81 LDA FPWORK1+F_MANT2 F379| 48 PHA F37A| A5 82 LDA FPWORK1+F_MANT3 F37C| 48 PHA F37D| A5 83 LDA FPWORK1+F_MANT4 F37F| 48 PHA F380| 4C AED2 JMP UPIPC1 F383| F383| F383| ;--------------------------------------------------- F383| ; FLOAT TOP-OF-STACK: FLT F383| ; Convert the integer tos to a floating-point F383| ; number, and push the result. F383| ;--------------------------------------------------- F383| ; FLT (float TOS) p-code: calls the float routine F383| ; and pushes the floating point value left in F383| ; FPWA#3. F383| ;--------------------------------------------------- F383| 20 01F3 FLT JSR FLOATI F386| A2 8A LDX #FPWORK3 F388| 20 78EF JSR PUSHFL F38B| 4C AED2 JMP UPIPC1 F38E| F38E| F38E| ;--------------------------------------------------- F38E| ; Truncation/round routine F38E| ;--------------------------------------------------- F38E| 38 F_TR_RO SEC F38F| A9 8D LDA #141. F391| E5 7F SBC FPWORK1+F_EXP F393| B0** BCS $02 F395| 68 $01 PLA F396| 68 PLA F397| 4C 29D2 JMP FLPTERR ; Execution error! F39A| F39A| AA $02 TAX F39B| E0 18 CPX #24. F39D| 30** BMI $03 F39F| F39F| A9 00 LDA #0 F3A1| 85 80 STA FPWORK1+F_MANT1 F3A3| 85 81 STA FPWORK1+F_MANT2 F3A5| 85 82 STA FPWORK1+F_MANT3 F3A7| 60 RTS F3A8| F3A8| F3A8| 46 80 $03 LSR FPWORK1+F_MANT1 F3AA| 66 81 ROR FPWORK1+F_MANT2 F3AC| 66 82 ROR FPWORK1+F_MANT3 F3AE| CA DEX F3AF| 10F7 BPL $03 F3B1| F3B1| A5 90 LDA FP_TEMP F3B3| F0** BEQ $04 F3B5| F3B5| A5 82 LDA FPWORK1+F_MANT3 F3B7| 10** BPL $04 F3B9| F3B9| E6 81 INC FPWORK1+F_MANT2 F3BB| D0** BNE $04 F3BD| F3BD| E6 80 INC FPWORK1+F_MANT1 F3BF| 10** BPL $04 F3C1| F3C1| 4C 95F3 JMP $01 ; Execution error! F3C4| F3C4| F3C4| A5 7E $04 LDA FPWORK1+F_SIGN F3C6| 10** BPL $05 F3C8| F3C8| A5 80 LDA FPWORK1+F_MANT1 F3CA| 49 FF EOR #255. F3CC| 85 80 STA FPWORK1+F_MANT1 F3CE| A5 81 LDA FPWORK1+F_MANT2 F3D0| 49 FF EOR #255. F3D2| 18 CLC F3D3| 69 01 ADC #1 F3D5| 85 81 STA FPWORK1+F_MANT2 F3D7| 90** BCC $05 F3D9| F3D9| E6 80 INC FPWORK1+F_MANT1 F3DB| 60 $05 RTS F3DC| F3DC| F3DC| ;--------------------------------------------------- F3DC| ; ROUND REAL: CSP 23 F3DC| ;--------------------------------------------------- F3DC| ; RND (round REAL) CSP routine: The floating point F3DC| ; number on TOS is converted to an integer and the F3DC| ; result is pushed. F3DC| ;--------------------------------------------------- F3DC| A9 01 RND LDA #1 F3DE| 85 90 STA FP_TEMP F3E0| F3E0| A2 7E LDX #FPWORK1 F3E2| 20 4AEF JSR POPFL F3E5| 20 8EF3 JSR F_TR_RO F3E8| F3E8| A5 80 LDA FPWORK1+F_MANT1 F3EA| 48 PHA F3EB| A5 81 LDA FPWORK1+F_MANT2 F3ED| 48 PHA F3EE| 4C 88D2 JMP UPIPC2 F3F1| F3F1| F3F1| ;--------------------------------------------------- F3F1| ; TRUNCATE REAL: CSP 22 F3F1| ;--------------------------------------------------- F3F1| ; TNC (truncate REAL) CSP routine: The floating point F3F1| ; number on TOS is converted to an integer by F3F1| ; truncation and the integer result is pushed. F3F1| ;--------------------------------------------------- F3F1| A9 00 TNC LDA #0 F3F3| 85 90 STA FP_TEMP F3F5| F3F5| A2 7E LDX #FPWORK1 F3F7| 20 4AEF JSR POPFL F3FA| 20 8EF3 JSR F_TR_RO F3FD| F3FD| A5 80 LDA FPWORK1+F_MANT1 F3FF| 48 PHA F400| A5 81 LDA FPWORK1+F_MANT2 F402| 48 PHA F403| 4C 88D2 JMP UPIPC2 F406| F406| F406| ;--------------------------------------------------- F406| ; POWER OF TEN: CSP 35 F406| ; If the integer tos is in the range 0..38, push F406| ; the real value 10^tos. If not tos not in range, F406| ; give an execution error. F406| ;--------------------------------------------------- F406| ; POT (power of ten) CSP routine: TOS contains an F406| ; integer. If it is > 38, zero is pushed onto the F406| ; stack. Otherwise this value is used as an index F406| ; into a table containing the floating point F406| ; representations for the various powers of ten. F406| ; The appropriate value is pushed. F406| ;--------------------------------------------------- F406| 68 POT PLA F407| AA TAX F408| 68 PLA F409| D0** BNE $01 F40B| E0 27 CPX #39. F40D| 10** BPL $01 F40F| F40F| 8A TXA F410| 0A ASL A F411| 0A ASL A F412| AA TAX F413| BD **** LDA POT_TBL+1,X F416| 48 PHA F417| BD **** LDA POT_TBL,X F41A| 48 PHA F41B| BD **** LDA POT_TBL+3,X F41E| 48 PHA F41F| BD **** LDA POT_TBL+2,X F422| 48 PHA F423| 4C 88D2 JMP UPIPC2 F426| F426| F426| A9 00 $01 LDA #0 F428| 48 PHA F429| 48 PHA F42A| 48 PHA F42B| 48 PHA F42C| 4C 29D2 JMP FLPTERR ; Execution error! F42F| F42F| F42F| ;--------------------------------------------------- F42F| ; Power of ten table: an array [0..38] of REAL F42F| ; used by the POT routine. F42F| ;--------------------------------------------------- F42F| 80 3F 00 00 POT_TBL .BYTE 080,03F,000,000 ; 10^0 F433| 20 41 00 00 .BYTE 020,041,000,000 ; 10^1 F437| C8 42 00 00 .BYTE 0C8,042,000,000 ; 10^2 F43B| 7A 44 00 00 .BYTE 07A,044,000,000 ; 10^3 F43F| 1C 46 00 40 .BYTE 01C,046,000,040 ; 10^4 F443| C3 47 00 50 .BYTE 0C3,047,000,050 ; 10^5 F447| 74 49 00 24 .BYTE 074,049,000,024 ; 10^6 F44B| 18 4B 80 96 .BYTE 018,04B,080,096 ; 10^7 F44F| BE 4C 20 BC .BYTE 0BE,04C,020,0BC ; 10^8 F453| 6E 4E 28 6B .BYTE 06E,04E,028,06B ; 10^9 F457| 15 50 F9 02 .BYTE 015,050,0F9,002 ; 10^10 F45B| BA 51 B7 43 .BYTE 0BA,051,0B7,043 ; 10^11 F45F| 68 53 A5 D4 .BYTE 068,053,0A5,0D4 ; 10^12 F463| 11 55 E7 84 .BYTE 011,055,0E7,084 ; 10^13 F467| B5 56 21 E6 .BYTE 0B5,056,021,0E6 ; 10^14 F46B| 63 58 A9 5F .BYTE 063,058,0A9,05F ; 10^15 F46F| 0E 5A CA 1B .BYTE 00E,05A,0CA,01B ; 10^16 F473| B1 5B BC A2 .BYTE 0B1,05B,0BC,0A2 ; 10^17 F477| 5E 5D 6B 0B .BYTE 05E,05D,06B,00B ; 10^18 F47B| 0A 5F 23 C7 .BYTE 00A,05F,023,0C7 ; 10^19 F47F| AD 60 EC 78 .BYTE 0AD,060,0EC,078 ; 10^20 F483| 58 62 27 D7 .BYTE 058,062,027,0D7 ; 10^21 F487| 07 64 78 86 .BYTE 007,064,078,086 ; 10^22 F48B| A9 65 16 68 .BYTE 0A9,065,016,068 ; 10^23 F48F| 53 67 1C C2 .BYTE 053,067,01C,0C2 ; 10^24 F493| 04 69 51 59 .BYTE 004,069,051,059 ; 10^25 F497| A5 6A A6 6F .BYTE 0A5,06A,0A6,06F ; 10^26 F49B| 4E 6C 8F CB .BYTE 04E,06C,08F,0CB ; 10^27 F49F| 01 6E 39 3F .BYTE 001,06E,039,03F ; 10^28 F4A3| A1 6F 08 8F .BYTE 0A1,06F,008,08F ; 10^29 F4A7| 49 71 CA F2 .BYTE 049,071,0CA,0F2 ; 10^30 F4AB| FC 72 7C 6F .BYTE 0FC,072,07C,06F ; 10^31 F4AF| 9D 74 AE C5 .BYTE 09D,074,0AE,0C5 ; 10^32 F4B3| 45 76 19 37 .BYTE 045,076,019,037 ; 10^33 F4B7| F6 77 DF 84 .BYTE 0F6,077,0DF,084 ; 10^34 F4BB| 9A 79 0C 13 .BYTE 09A,079,00C,013 ; 10^35 F4BF| 40 7B CE 97 .BYTE 040,07B,0CE,097 ; 10^36 F4C3| F0 7C C2 BD .BYTE 0F0,07C,0C2,0BD ; 10^37 F4C7| 96 7E 9C 76 .BYTE 096,07E,09C,076 ; 10^38 F4CB| F4CB| F4CB| F4CB| ;================================================================= F4CB| F4CB| .INCLUDE LOC1.3:UNIT1.3.TEXT F4CB| .PAGE F4CB| 0DD2 A_IBU .WORD INTBYUSR ; Addr of "Interrupt by user" F4CD| F4CD| F4CD| ; Control of type "A" & "B" character checking: F4CD| ; Bit 0 turns Type "A" char check on (0) / off (1) F4CD| ; Chars: Cntrl-A, -Z, -E, -W F4CD| ; Bit 1 turns Type "B" char check on (0) / off (1) F4CD| ; Chars: Cntrl-S, -F, -@ F4CD| 00 U_SPCH .BYTE 0 ; Value stored in SPCHAR F4CE| F4CE| F4CE| ;--------------------------------------------------- F4CE| ; Table of subroutine addresses to be called when F4CE| ; writing to a character-oriented unit. F4CE| **** WRITTBL .WORD BIOS+3 ; Unit 1: CWRITE F4D0| **** .WORD BIOS+3 ; 2: CWRITE F4D2| **** .WORD BIOS+33. ; 3: GRAPHIC: write F4D4| 0000 .WORD 0 ; 4: not char-oriented F4D6| 0000 .WORD 0 ; 5: not char-oriented F4D8| **** .WORD BIOS+9 ; 6: PWRITE F4DA| 0000 .WORD 0 ; 7: no REMIN: write F4DC| **** .WORD BIOS+27. ; 8: RWRITE F4DE| F4DE| F4DE| ;--------------------------------------------------- F4DE| ; Table of subroutine addresses to be called when F4DE| ; reading from a character-oriented unit. F4DE| **** READTBL .WORD BIOS+0 ; Unit 1: CREAD F4E0| **** .WORD BIOS+0 ; 2: CREAD F4E2| 0000 .WORD 0 ; 3: no GRAPHIC: read F4E4| 0000 .WORD 0 ; 4: not char-oriented F4E6| 0000 .WORD 0 ; 5: not char-oriented F4E8| 0000 .WORD 0 ; 6: no PRINTER: read F4EA| **** .WORD BIOS+24. ; 7: RREAD F4EC| 0000 .WORD 0 ; 8: no REMOTE: read F4EE| F4EE| F4EE| ;--------------------------------------------------- F4EE| ; Subroutine to see if unit # is valid. Enter with F4EE| ; unit number in A- and X-reg. F4EE| ;--------------------------------------------------- F4EE| 29 80 U_VALID AND #128. ; If unit # is >= 128, F4F0| D0** BNE $01 ; it's a user device. F4F2| 8A TXA F4F3| C9 15 CMP #21. ; If unit is from F4F5| B0** BCS $02 ; 1 to 20, it's OK. F4F7| C9 01 CMP #1 F4F9| 90** BCC $02 F4FB| 60 RTS F4FC| F4FC| 8A $01 TXA ; If unit is from F4FD| 29 7F AND #127. ; 128 to 143, F4FF| 85 96 STA U_TEMP1 F501| C9 10 CMP #16. F503| B0** BCS $02 F505| 0A ASL A F506| 65 96 ADC U_TEMP1 ; and a driver is F508| A8 TAY ; attached, it's OK F509| B9 **** LDA UDJMPVEC+2,Y F50C| F0** BEQ $02 F50E| 8A TXA F50F| 60 RTS F510| F510| ; The unit number is not valid! F510| F510| A2 02 $02 LDX #2 ; Illegal volume F512| 8E 1EBD STX IORSLT F515| 68 PLA F516| 68 PLA F517| 4C 88D2 JMP UPIPC2 F51A| F51A| F51A| ;--------------------------------------------------- F51A| ; IORESULT: CSP 34 F51A| ;--------------------------------------------------- F51A| ; IOR (IOResult) CSP routine: pushes the last I/O F51A| ; error value (stored at IORSLT) onto the stack. F51A| ;--------------------------------------------------- F51A| AD 1FBD IOR LDA IORSLT+1 F51D| 48 PHA F51E| AD 1EBD LDA IORSLT F521| 48 PHA F522| 4C 88D2 JMP UPIPC2 F525| F525| F525| ;--------------------------------------------------- F525| ; IOCHECK: CSP 0 F525| ;--------------------------------------------------- F525| ; IOC (IOCheck) CSP routine: checks IORSLT. If <> 0, F525| ; a run-time error is caused. F525| ;--------------------------------------------------- F525| AD 1EBD IOC LDA IORSLT F528| F0** BEQ $01 F52A| 4C 15D2 JMP IOERR ; Execution error! F52D| 4C 88D2 $01 JMP UPIPC2 F530| F530| F530| ;--------------------------------------------------- F530| ; UNITBUSY: CSP 35 F530| ;--------------------------------------------------- F530| ; UBUSY (UnitBusy) CSP routine: checks to make sure F530| ; the specified unit is on-line, then pushes FALSE F530| ; onto the evaluation stack (since the unit will F530| ; never be busy). F530| ;--------------------------------------------------- F530| 68 UBUSY PLA ; Get unit number. F531| AA TAX F532| 68 PLA ; (Ignore m.s.byte) F533| 8A TXA F534| 20 EEF4 JSR U_VALID F537| A9 00 LDA #0 ; Push FALSE. F539| 48 PHA F53A| 48 PHA F53B| 4C 88D2 JMP UPIPC2 F53E| F53E| F53E| ;--------------------------------------------------- F53E| ; UNITWAIT: CSP 37 F53E| ;--------------------------------------------------- F53E| ; UWAIT (UnitWait) CSP routine: Since all I/O is F53E| ; synchronous, this routine does nothing more than F53E| ; pop the unit number off the stack, make sure the F53E| ; unit is on-line, and return control to the main F53E| ; interpreter loop. F53E| ;--------------------------------------------------- F53E| 68 UWAIT PLA F53F| AA TAX F540| 68 PLA F541| 8A TXA F542| 20 EEF4 JSR U_VALID F545| 4C 88D2 JMP UPIPC2 F548| F548| F548| ;--------------------------------------------------- F548| ; UNITSTATUS: CSP 12 F548| ;--------------------------------------------------- F548| ; USTAT (UnitStatus) CSP routine: pops unnecessary F548| ; data off the stack, modifies the stack so it is F548| ; in the format expected by the BIOS Status routines, F548| ; then transfers control to the appropriate BIOS F548| ; subroutine. F548| ; Calling sequence: F548| ; UnitStatus(unit_num,result,control); F548| ;--------------------------------------------------- F548| A9 04 USTAT LDA #4 F54A| 85 86 STA U_TEMP F54C| 68 PLA ; Get control word, F54D| 85 8C STA U_CONWD F54F| 68 PLA F550| 85 8D STA U_CONWD+1 F552| 68 PLA ; result array address, F553| 85 84 STA U_R_ADR F555| 68 PLA F556| 85 85 STA U_R_ADR+1 F558| 18 CLC F559| 68 PLA F55A| 65 84 ADC U_R_ADR F55C| 85 84 STA U_R_ADR F55E| 68 PLA F55F| 65 85 ADC U_R_ADR+1 F561| 85 85 STA U_R_ADR+1 F563| 68 PLA F564| AA TAX F565| 68 PLA F566| 8A TXA F567| 20 EEF4 JSR U_VALID F56A| F56A| ; Put parameters back on in BIOS order. F56A| A5 8D LDA U_CONWD+1 F56C| 48 PHA ; Control word, F56D| A5 8C LDA U_CONWD F56F| 48 PHA F570| A5 85 LDA U_R_ADR+1 F572| 48 PHA ; result array address. F573| A5 84 LDA U_R_ADR F575| 48 PHA F576| 8A TXA ; Get unit number. F577| 29 80 AND #128. ; If >= 128, F579| F0** BEQ $01 F57B| D0** BNE USER_DEV ; it's a user-defined device. F57D| 8A $01 TXA F57E| 0A ASL A F57F| A8 TAY F580| ; Check high byte of entry in DISKNUM table. F580| B9 **** LDA DISKNUM-1,Y F583| F0** BEQ $02 ; = 0: Must be disk unit number F585| C9 FF CMP #0FF F587| F0** BEQ $03 ; = $FF: Not block structured F589| D0** BNE USR_DVR ; ELSE: user-attached driver F58B| F58B| F58B| ; UnitStatus on disk device: F58B| B9 **** $02 LDA DISKNUM-2,Y ; Get disk number. F58E| 20 **** JSR LFF30 ; Call DSTATT (in BIOS) F591| 4C **** JMP U_GOBCK ; Return to system. F594| F594| F594| ; UnitStatus on non-block structured device F594| 8A $03 TXA ; Move unit number F595| A8 TAY ; to Y-reg. F596| A2 04 LDX #4 F598| C0 03 CPY #3 ; If unit 1 or 2, F59A| B0** BCS $04 F59C| 20 **** JSR LFF2A ; call CSTAT F59F| 4C **** JMP U_GOBCK ; Return to system. F5A2| F5A2| C0 06 $04 CPY #6 ; If unit = 6, F5A4| D0** BNE $05 F5A6| 20 **** JSR LFF2D ; call PSTAT F5A9| 4C **** JMP U_GOBCK ; Return to system. F5AC| F5AC| C0 07 $05 CPY #7 ; If unit = 7 F5AE| F0** BEQ $06 F5B0| C0 08 CPY #8 ; or unit = 8, F5B2| D0** BNE $07 F5B4| 20 **** $06 JSR LFF33 ; call RSTAT. F5B7| 4C **** JMP U_GOBCK ; Return to system. F5BA| F5BA| F5BA| A2 09 $07 LDX #9 ; Error = bad volume! F5BC| 68 PLA F5BD| 68 PLA F5BE| 68 PLA F5BF| 68 PLA F5C0| 4C **** JMP U_GOBCK ; Return to system. F5C3| F5C3| F5C3| ;--------------------------------------------------- F5C3| ; UNITCLEAR: CSP 38 F5C3| ;--------------------------------------------------- F5C3| ; UCLR (UnitClear) CSP routine: initializes the F5C3| ; device specified by the word on TOS. There is F5C3| ; code to handle both user defined devices, REMIN: F5C3| ; & REMOUT:, character oriented devices, and block F5C3| ; structured devices. F5C3| ;--------------------------------------------------- F5C3| A9 02 UCLR LDA #2 F5C5| 85 86 STA U_TEMP F5C7| 68 PLA F5C8| AA TAX F5C9| 68 PLA F5CA| 8A TXA F5CB| 20 EEF4 JSR U_VALID F5CE| 29 80 AND #128. F5D0| F0** BEQ UCLR_1 F5D2| F5D2| ; Come here when unit number is attached to a F5D2| ; user-defined device. F5D2| USER_DEV F5D2| 8A TXA F5D3| A6 86 LDX U_TEMP ; Load unit number. F5D5| 20 **** JSR KUDRWI ; Call UDRWI. F5D8| 4C **** JMP U_GOBCK ; Return to system. F5DB| F5DB| F5DB| 8A UCLR_1 TXA ; Get unit number. F5DC| C9 07 CMP #7 ; If 7 (REMIN:), F5DE| D0** BNE $01 F5E0| A9 08 LDA #8 ; change to 8 (REMOUT:). F5E2| AA TAX F5E3| 0A $01 ASL A F5E4| A8 TAY F5E5| ; Check high byte of entry in DISKNUM table. F5E5| B9 **** LDA DISKNUM-1,Y F5E8| F0** BEQ UCLR_2 ; = 0: Must be disk unit number F5EA| C9 FF CMP #0FF F5EC| F0** BEQ UCLR_3 ; = $FF: Not block structured F5EE| F5EE| F5EE| ; I/O request is to user-attached driver F5EE| 8A USR_DVR TXA ; Unit number in A-reg. F5EF| A6 86 LDX U_TEMP ; Driver function in X-reg. F5F1| 20 **** JSR KPSUBD ; Call the user driver. F5F4| 4C **** JMP U_GOBCK ; Return to system. F5F7| F5F7| F5F7| ; UnitClear is directed to a disk unit number. F5F7| B9 **** UCLR_2 LDA DISKNUM-2,Y ; Get the drive number. F5FA| 20 **** JSR LFF15 ; Call DINIT. F5FD| 4C **** JMP U_GOBCK ; Return to system. F600| F600| F600| ; UnitClear is directed to character-oriented unit. F600| 8A UCLR_3 TXA ; Put unit number in F601| A8 TAY ; X- and Y- regs. F602| A2 02 LDX #2 ; Preset err = 2 (bad dev #) F604| F604| C0 03 CPY #3 ; If unit number is 1 or 2, F606| B0** BCS $06 F608| A9 00 LDA #0 ; Initialize unit 1, 2 F60A| 85 A1 STA UN_DL_F+1 ; DLE expand flags. F60C| 85 A2 STA UN_DL_F+2 F60E| AD CCF4 LDA A_IBU+1 ; Push addr of F611| 48 PHA ; "interrupt by user" F612| AD CBF4 LDA A_IBU ; routine. F615| 48 PHA F616| AD **** LDA A_SYSCOM+1 ; Push addr of SYSCOM F619| 48 PHA F61A| AD **** LDA A_SYSCOM F61D| 48 PHA F61E| 20 **** JSR LFF06 ; Call CINIT. F621| 4C **** JMP U_GOBCK ; Return to system. F624| F624| F624| C0 06 $06 CPY #6 ; If unit number is 6, F626| D0** BNE $08 F628| A9 00 LDA #0 ; Clear unit's F62A| 85 A6 STA UN_DL_F+6 ; DLE flag. F62C| 20 **** JSR LFF0C ; Call PINIT. F62F| 4C **** JMP U_GOBCK ; Return to system. F632| F632| F632| C0 08 $08 CPY #8 ; If unit number is 8, F634| D0** BNE $03 F636| A9 00 LDA #0 ; Clear units' F638| 85 A7 STA UN_DL_F+7 ; DLE flags. F63A| 85 A8 STA UN_DL_F+8 F63C| 20 **** JSR LFF1E ; Call RINIT. F63F| 4C **** JMP U_GOBCK ; Return to system. F642| F642| F642| C0 03 $03 CPY #3 ; If unit number is 3, F644| D0** BNE $999 F646| 20 **** JSR LFF24 ; call GINIT. F649| F649| F649| A2 09 $999 LDX #9 ; Error = 9 (volume not found) F64B| 4C **** JMP U_GOBCK ; Return to system. F64E| F64E| F64E| F64E| ;--------------------------------------------------- F64E| ; Set value of SPCHAR, then fall thru to U_GOBCK F64E| U_SET_GO F64E| AD CDF4 LDA U_SPCH F651| 8D 1CBF STA SPCHAR F654| F654| ; Store I/O error result (from X-reg) F654| ; and return to main interpreter loop. F654| 8E 1EBD U_GOBCK STX IORSLT F657| 4C 88D2 JMP UPIPC2 F65A| F65A| F65A| ;--------------------------------------------------- F65A| ; Disk I/O subroutine: handles block structured F65A| ; I/O requests. F65A| ;--------------------------------------------------- F65A| U_SETSTK F65A| 68 PLA ; Save local F65B| 85 98 STA U_RTN ; return address. F65D| 68 PLA F65E| 85 99 STA U_RTN+1 F660| F660| A5 8D LDA U_MODE+1 ; Put parameters F662| 48 PHA ; onto the stack F663| A5 8C LDA U_MODE ; in the proper order. F665| 48 PHA F666| A9 00 LDA #0 F668| 48 PHA F669| 8A TXA F66A| 48 PHA F66B| A5 85 LDA U_B_ADR+1 F66D| 48 PHA F66E| A5 84 LDA U_B_ADR F670| 48 PHA F671| A5 83 LDA U_BFLN+1 F673| 48 PHA F674| A5 82 LDA U_BFLN F676| 48 PHA F677| A5 81 LDA U_BLKNM+1 F679| 48 PHA F67A| A5 80 LDA U_BLKNM F67C| 48 PHA F67D| A5 99 LDA U_RTN+1 ; Push internal F67F| 48 PHA ; return address F680| A5 98 LDA U_RTN F682| 48 PHA F683| 60 RTS ; and return. F684| F684| F684| F684| ;--------------------------------------------------- F684| ; Set value of SPCHAR, then return to interpreter. F684| ;--------------------------------------------------- F684| U_SET_GO_1 F684| AD CDF4 LDA U_SPCH F687| 8D 1CBF STA SPCHAR F68A| 4C 88D2 JMP UPIPC2 F68D| F68D| F68D| ;--------------------------------------------------- F68D| ; UNITREAD: CSP 5 F68D| ;--------------------------------------------------- F68D| ; UREAD (UnitRead) CSP routine: loads the A-reg with F68D| ; 0 and jumps to the unit I/O code. F68D| ;--------------------------------------------------- F68D| A9 00 UREAD LDA #0 F68F| 4C **** JMP UNIT_IO F692| F692| ;--------------------------------------------------- F692| ; UNITWRITE: CSP 6 F692| ;--------------------------------------------------- F692| ; UWRITE (UnitWrite) CSP routine: loads the A-reg F692| ; with 1 and drops through to the unit I/O code. F692| ;--------------------------------------------------- F692| A9 01 UWRT LDA #1 F694| F694| ;--------------------------------------------------- F694| ; Unit I/O subroutine: handles UnitRead and UnitWrite F694| ; requests of the Pascal operating system. It F694| ; modifies the parameters on the stack and F694| ; dispatches the I/O request to the proper BIOS F694| ; subroutine. F694| ; Parameter order in Pascal: F694| ; UnitRead(unit_num, buffer, length, block_num, mode); F694| ;--------------------------------------------------- F694| 85 86 UNIT_IO STA U_TEMP F696| A0 01 LDY #1 F698| 84 88 STY U_DLE_FLG F69A| 84 8A STY U_LF_FLG F69C| AC 1CBF LDY SPCHAR F69F| 8C CDF4 STY U_SPCH F6A2| F6A2| 68 PLA ; Get mode parameter. F6A3| AA TAX F6A4| 85 8C STA U_MODE F6A6| ; Note: in UNITREAD, bits 4/5 control Type A/B F6A6| ; character checking. F6A6| 4A LSR A ; Move bits 4/5 F6A7| 4A LSR A ; to 0/1, F6A8| 4A LSR A F6A9| 4A LSR A F6AA| 29 03 AND #3 ; and isolate. F6AC| 0D 1CBF ORA SPCHAR ; If either is set, F6AF| 8D 1CBF STA SPCHAR ; set bit in SPCHAR. F6B2| A0 00 LDY #0 ; Preset error value F6B4| 8C 1EBD STY IORSLT ; to 0. F6B7| 8A TXA ; Get mode parameter. F6B8| 29 04 AND #4 ; Isolate EOF bit. F6BA| D0** BNE $01 F6BC| 84 88 STY U_DLE_FLG F6BE| 8A $01 TXA ; Get mode parameter. F6BF| 29 08 AND #8 ; Isolate LF bit. F6C1| D0** BNE $02 F6C3| 84 8A STY U_LF_FLG F6C5| 68 $02 PLA ; Get other byte of MODE. F6C6| 85 8D STA U_MODE+1 F6C8| F6C8| 68 PLA ; Get block number parameter. F6C9| 85 80 STA U_BLKNM F6CB| 68 PLA F6CC| 85 81 STA U_BLKNM+1 F6CE| F6CE| 68 PLA ; Get length parameter F6CF| 85 82 STA U_BFLN F6D1| F0** BEQ $04 F6D3| 68 PLA F6D4| 85 83 STA U_BFLN+1 F6D6| 30** BMI $03 F6D8| 4C **** JMP $05 F6DB| F6DB| 68 $03 PLA ; Length <= 0. Pop F6DC| 68 PLA ; remaining F6DD| 68 PLA ; parameters F6DE| 68 PLA ; and return. F6DF| 68 PLA F6E0| 68 PLA F6E1| 4C 88D2 JMP UPIPC2 F6E4| F6E4| 68 $04 PLA F6E5| F0F4 BEQ $03 F6E7| 30F2 BMI $03 F6E9| F6E9| 85 83 STA U_BFLN+1 F6EB| F6EB| 68 $05 PLA ; Get buffer address. F6EC| 85 84 STA U_B_ADR F6EE| 68 PLA F6EF| 85 85 STA U_B_ADR+1 F6F1| F6F1| 18 CLC ; Get offset and add F6F2| 68 PLA ; to buffer address. F6F3| 65 84 ADC U_B_ADR F6F5| 85 84 STA U_B_ADR F6F7| 68 PLA F6F8| 65 85 ADC U_B_ADR+1 F6FA| 85 85 STA U_B_ADR+1 F6FC| F6FC| 68 PLA ; Get unit number. F6FD| 85 8E STA U_UNIT F6FF| AA TAX F700| 68 PLA F701| 8A TXA F702| 20 EEF4 JSR U_VALID ; Make sure it's valid. F705| 29 80 AND #128. ; See what kind of driver. F707| F0** BEQ $06 F709| F709| ; UnitRead/Write for user defined device (>= 128) F709| 20 5AF6 JSR U_SETSTK ; Put parameters onto stack. F70C| 8A TXA ; Set unit #. F70D| A6 86 LDX U_TEMP ; Get function. F70F| 20 **** JSR KUDRWI ; Call UDRWI. F712| 4C 4EF6 JMP U_SET_GO ; Set SPCHAR, IORSLT, then return. F715| F715| ; Unit # <= 20. Is it block- or character-oriented. F715| 8A $06 TXA F716| 0A ASL A F717| A8 TAY F718| B9 **** LDA DISKNUM-1,Y ; Get DISKNUM table entry. F71B| F0** BEQ $07 ; = 0: It's a disk. F71D| C9 FF CMP #0FF ; = $FF: It's char-oriented. F71F| F0** BEQ $09 F721| F721| ; Request is for user-attached block-oriented driver. F721| 20 5AF6 JSR U_SETSTK ; Put parameters onto stack. F724| 8A TXA ; Set unit #. F725| A6 86 LDX U_TEMP ; Get function (read or write). F727| 20 **** JSR KPSUBD ; Go to the driver. F72A| 4C 4EF6 JMP U_SET_GO ; Set SPCHAR, IORSLT, then return. F72D| F72D| F72D| ; Request is for standard BIOS disk driver. F72D| BE **** $07 LDX DISKNUM-2,Y ; Get disk drive number. F730| 20 5AF6 JSR U_SETSTK ; Put parameters onto stack. F733| A5 86 LDA U_TEMP ; Get function (read or write). F735| D0** BNE $08 F737| F737| 20 **** JSR LFF12 ; Do disk read (DREAD). F73A| 4C 4EF6 JMP U_SET_GO ; Set SPCHAR, IORSLT, then return. F73D| F73D| 20 **** $08 JSR LFF0F ; Do disk write (DWRITE). F740| 4C 4EF6 JMP U_SET_GO ; Set SPCHAR, IORSLT, then return. F743| F743| F743| ; Request is for character-oriented driver. F743| A9 01 $09 LDA #1 F745| E0 01 CPX #1 F747| D0** BNE $10 F749| A9 00 LDA #0 F74B| 85 7E $10 STA Z7E F74D| F74D| E0 09 CPX #9 ; If unit number >= 9, F74F| 90** BCC $11 F751| A2 02 LDX #2 ; Error 2: Bad device number. F753| D0** BNE $13 F755| F755| 8A $11 TXA ; Use unit number as F756| 0A ASL A ; word index into read & F757| AA TAX ; write driver table. F758| F758| BD CCF4 LDA WRITTBL-2,X ; Set write address. F75B| 85 94 STA U_WR_ADR F75D| BD CDF4 LDA WRITTBL-1,X F760| 85 95 STA U_WR_ADR+1 F762| F762| BD DCF4 LDA READTBL-2,X ; Set read address. F765| 85 90 STA U_RD_ADR F767| BD DDF4 LDA READTBL-1,X F76A| 85 91 STA U_RD_ADR+1 F76C| F76C| A5 86 LDA U_TEMP ; Get read/write flag. F76E| F0** BEQ $14 ; 0 = read. F770| F770| A5 95 LDA U_WR_ADR+1 ; Check for bad write request. F772| D0** BNE $15 F774| F774| ; Read or Write table has an entry of 0 F774| A2 03 $12 LDX #3 ; Error code = 3: illegal I/O req. F776| 4C 4EF6 $13 JMP U_SET_GO ; Set SPCHAR, IORSLT, then return. F779| F779| F779| A5 91 $14 LDA U_RD_ADR+1 ; Check for bad read request. F77B| F0F7 BEQ $12 F77D| F77D| F77D| ; Read or Write request is valid. F77D| A6 82 $15 LDX U_BFLN ; Get the buffer length F77F| 4C **** JMP U_RW_GO ; and go to I/O. F782| F782| F782| U_RW_TOP F782| A5 86 LDA U_TEMP ; Get read/write flag. F784| D0** BNE U_DOWR ; 0 = read. F786| F786| ; Character-oriented read request. F786| 20 **** JSR DO_U_RD ; Call the driver. F789| A2 00 LDX #0 F78B| 81 84 STA @U_B_ADR,X F78D| F78D| A4 88 LDY U_DLE_FLG F78F| D0** BNE $04 F791| CD 70BD CMP EOF_CH F794| D0** BNE $04 F796| F796| A0 01 LDY #1 F798| C4 8E CPY U_UNIT F79A| F0** BEQ $01 F79C| F79C| 4C 84F6 JMP U_SET_GO_1 ; Set SPCHAR then return. F79F| F79F| F79F| ; Store zeroes in input buffer. F79F| A9 00 $01 LDA #0 F7A1| F7A1| 81 84 $02 STA @U_B_ADR,X ; Store 0 in buffer. F7A3| E6 84 INC U_B_ADR ; Bump buffer address. F7A5| D0** BNE $03 F7A7| E6 85 INC U_B_ADR+1 F7A9| C6 82 $03 DEC U_BFLN ; Decrement length. F7AB| D0F4 BNE $02 F7AD| C6 83 DEC U_BFLN+1 F7AF| 10F0 BPL $02 ; If <> 0, stay in loop. F7B1| F7B1| 4C 84F6 JMP U_SET_GO_1 ; Set SPCHAR then return. F7B4| F7B4| F7B4| A4 7E $04 LDY Z7E F7B6| D0** BNE U_RW_BUMP F7B8| 20 **** JSR U_SPCHK ; Check for special char. F7BB| 4C **** JMP U_RW_BUMP F7BE| F7BE| F7BE| ; Character-oriented Write request F7BE| A2 00 U_DO_WR LDX #0 F7C0| A1 84 LDA @U_B_ADR,X F7C2| 20 **** JSR U_SPCHK ; Check for special char. F7C5| F7C5| F7C5| ; Read and Write both come here. F7C5| U_RW_BUMP F7C5| E6 84 INC U_B_ADR F7C7| D0** BNE $01 F7C9| E6 85 INC U_B_ADR+1 F7CB| C6 82 $01 DEC U_BFLN F7CD| F7CD| ; This is where UnitRead and UnitWrite requests start. F7CD| D0B3 U_RW_GO BNE U_RW_TOP ; If more to do, F7CF| C6 83 DEC U_BFLN+1 ; go to top of F7D1| 10AF BPL U_RW_TOP ; Read/Write code. F7D3| F7D3| 4C 84F6 JMP U_SET_GO_1 ; Set SPCHAR then return. F7D6| F7D6| F7D6| F7D6| ;--------------------------------------------------- F7D6| ; Subroutine to check for special characters. F7D6| ;--------------------------------------------------- F7D6| A4 88 U_SPCHK LDY U_DLE_FLG F7D8| D0** BNE $04 F7DA| A4 8E LDY U_UNIT F7DC| B6 A0 LDX UN_DL_F,Y F7DE| F0** BEQ $03 F7E0| F7E0| 38 SEC ; Subtract 31 from F7E1| E9 1F SBC #31. ; character to get F7E3| 85 98 STA U_NUMBK ; number of blanks. F7E5| A9 20 $01 LDA #32. ; Load a space. F7E7| C6 98 DEC U_NUMBK F7E9| F0** BEQ $02 F7EB| 20 **** JSR DO_U_WR ; Call the write dvr. F7EE| 4C E5F7 JMP $01 F7F1| F7F1| A2 00 $02 LDX #0 ; Clear the unit's F7F3| A4 8E LDY U_UNIT ; DLE flag. F7F5| 96 A0 STX UN_DL_F,Y F7F7| 60 RTS F7F8| F7F8| F7F8| C9 10 $03 CMP #16. ; Check for DLE. F7FA| D0** BNE $04 F7FC| A9 01 LDA #1 ; YES: Set the unit's F7FE| 99 A0 00 STA UN_DL_F,Y ; flag. F801| 60 RTS F802| F802| A4 8A $04 LDY U_LF_FLG F804| D0** BNE $05 F806| C9 0D CMP #13. ; If carriage return, F808| D0** BNE $05 F80A| 20 **** JSR DO_U_WR ; Call the write dvr. F80D| A9 0A LDA #10. ; Load a line feed. F80F| 20 **** JSR DO_U_WR ; Call the write dvr. F812| 60 RTS F813| F813| F813| 20 **** $05 JSR DO_U_WR ; Call the write dvr. F816| 60 RTS F817| F817| F817| ; Address to be pushed onto stack before jumping F817| ; to character-oriented driver. F817| **** A_URETRN .WORD U_RETRN-1 F819| F819| F819| ; Here's what happens upon return from driver... F819| 8E 1EBD U_RETRN STX IORSLT F81C| 60 RTS F81D| F81D| F81D| ;--------------------------------------------------- F81D| ; Subroutine which calls the F81D| ; char-oriented read driver. F81D| ;--------------------------------------------------- F81D| A8 DO_U_WR TAY F81E| AD 18F8 LDA A_URETRN+1 ; Push return address. F821| 48 PHA F822| AD 17F8 LDA A_URETRN F825| 48 PHA F826| 98 TYA ; A-reg = out char. F827| A4 8E LDY U_UNIT ; Y-reg = unit num. F829| A2 01 LDX #1 ; Function = WRITE. F82B| 6C 9400 JMP @U_WR_ADR ; Go to the driver. F82E| F82E| F82E| ;--------------------------------------------------- F82E| ; Subroutine which calls the F82E| ; char-oriented read driver. F82E| ;--------------------------------------------------- F82E| A8 DO_U_RD TAY F82F| AD 18F8 LDA A_URETRN+1 ; Push return address. F832| 48 PHA F833| AD 17F8 LDA A_URETRN F836| 48 PHA F837| 98 TYA F838| A4 8E LDY U_UNIT ; Y-reg = unit num. F83A| A2 00 LDX #0 ; Function = READ. F83C| 6C 9000 JMP @U_RD_ADR ; Go to the driver. F83F| F83F| F83F| F83F| ;================================================================= F83F| F83F| .INCLUDE LOC1.3:IOCALL1.3.TEXT F83F| 5CBB A_STKSTR .WORD START_STACK F841| 7EBD A_SEGTB2 .WORD SEG_TABLE F843| 1EBD A_SYSCOM .WORD IORSLT ; Addr of SYSCOM F845| 47D7 A_XIT .WORD XIT ; XIT instruction (for XITLOC) F847| F847| 00 LF847 .BYTE 0 F848| 00 LF848 .BYTE 0 F849| F849| 00 WAIT_CNT .BYTE 0 ; Used when waiting for F84A| F84A| 00 M_CH_CNT .BYTE 0 ; Used as character count. F84B| F84B| 0008 LOWEST_CODE .WORD 00800 ; Initial value of CODELOW F84D| 00C0 HIGHEST_CODE .WORD 0C000 ; Initial value of CODEP F84F| F84F| F84F| INSRT_MSG F84F| 0D .BYTE 0D F850| 49 6E 73 65 72 74 20 .ASCII "Insert boot disk with SYSTEM.PASCAL" F857| 62 6F 6F 74 20 64 69 F85E| 73 6B 20 77 69 74 68 F865| 20 53 59 53 54 45 4D F86C| 2E 50 41 53 43 41 4C F873| 0D 0A .BYTE 0D,0A F875| 6F 6E 20 69 74 2C 20 .ASCII "on it, then press RETURN#" F87C| 74 68 65 6E 20 70 72 F883| 65 73 73 20 52 45 54 F88A| 55 52 4E 23 F88E| F88E| SYS_PAS_MSG F88E| 0D .BYTE 0D F88F| 53 59 53 54 45 4D 2E .ASCII "SYSTEM.PASCAL is not V1.3#" F896| 50 41 53 43 41 4C 20 F89D| 69 73 20 6E 6F 74 20 F8A4| 56 31 2E 33 23 F8A9| F8A9| NEED_128_MSG F8A9| 0D .BYTE 0D F8AA| 31 32 38 4B 20 6D 65 .ASCII "128K memory required#" F8B1| 6D 6F 72 79 20 72 65 F8B8| 71 75 69 72 65 64 23 F8BF| F8BF| CEF4 A_WTBL .WORD WRITTBL F8C1| DEF4 A_RTBL .WORD READTBL F8C3| F8C3| ;--------------------------------------------------- F8C3| ; Subroutine entry which jumps to GENIT (to init F8C3| ; the serial card in slot 3) F8C3| ;--------------------------------------------------- F8C3| 6C **** TO_GENIT JMP @A_GENIT F8C6| F8C6| F8C6| ;--------------------------------------------------- F8C6| ; Address of cold-start code. F8C6| ;--------------------------------------------------- F8C6| **** A_C_START .WORD C_START F8C8| F8C8| ;--------------------------------------------------- F8C8| ; Relocate the cold-start code to location $6800. F8C8| ;--------------------------------------------------- F8C8| AD C6F8 LOAD_CS LDA A_C_START ; Set up source F8CB| 85 00 STA CS_SRC F8CD| AD C7F8 LDA A_C_START+1 F8D0| 85 01 STA CS_SRC+1 F8D2| A9 68 LDA #068 ; and destination addr. F8D4| 85 03 STA CS_DST+1 F8D6| A9 00 LDA #0 F8D8| 85 02 STA CS_DST F8DA| AA TAX ; Initialize page and F8DB| A8 TAY ; byte counter. F8DC| F8DC| B1 00 $01 LDA @CS_SRC,Y ; Move byte from source F8DE| 91 02 STA @CS_DST,Y ; to destination. F8E0| C8 INY ; Bump byte index. F8E1| D0F9 BNE $01 ; Keep moving until page boundary. F8E3| F8E3| E6 01 INC CS_SRC+1 ; Bump page numbers in F8E5| E6 03 INC CS_DST+1 ; source/dest address. F8E7| E8 INX ; Bump page counter. F8E8| E0 05 CPX #5 ; If < 5 pages moved, F8EA| D0F0 BNE $01 ; move another page. F8EC| F8EC| 4C 0068 JMP C_S_CODE ; Go to cold-start code. F8EF| F8EF| .PAGE F8EF| ;--------------------------------------------------- F8EF| ; This is the cold-start code, relocated to location F8EF| ; $6800 before execution. F8EF| ;--------------------------------------------------- F8EF| F8EF| C_START F8EF| 90EF C_S_OFFSET .EQU C_START-C_S_CODE F8EF| D8 CLD ; Clear decimal mode and F8F0| 78 SEI ; disable interrupts. F8F1| F8F1| ; Clear the Apple's memory from 0000 through $BFFF F8F1| ; with the exception of F8F1| ; $6800 - $6AFF {Cold start code} and F8F1| ; $0400 - $07FF {Text page & I/O vars} F8F1| F8F1| A9 00 LDA #0 ; Initialize pointers F8F3| 85 BD STA C_S_PNT ; and registers to 0. F8F5| 85 BE STA C_S_PNT+1 F8F7| A8 TAY F8F8| AA TAX F8F9| F8F9| 91 BD $01 STA @C_S_PNT,Y ; Fill a page F8FB| C8 INY ; of memory F8FC| D0FB BNE $01 ; with 0s. F8FE| F8FE| E6 BE INC C_S_PNT+1 ; Bump the page pointer. F900| E8 INX ; Bump the page counter. F901| E0 04 CPX #4 ; Check for text page. F903| F0** BEQ $02 F905| F905| E0 C0 CPX #0C0 ; Check for end. F907| F0** BEQ $03 F909| E0 68 CPX #068 ; If up to page $68, F90B| D0EC BNE $01 F90D| A2 6D LDX #06D ; skip to page $6D. F90F| 86 BE STX C_S_PNT+1 F911| D0E6 BNE $01 F913| A2 08 $02 LDX #8 ; If up to page 4, F915| 86 BE STX C_S_PNT+1 ; skip to page 8. F917| D0E0 BNE $01 F919| F919| ; All done clearing memory. F919| F919| ; Next: determine what kind of cards are in the slots. F919| F919| A0 C7 $03 LDY #0C7 ; Start with slot # 7 PROM. F91B| 84 C6 $04 STY C_S_SLTPT+1 F91D| 20 **** JSR C_S_CKSUM ; Take first checksum. F920| 85 D0 STA C_S_SUMVL F922| 86 D1 STX C_S_SUMVL+1 F924| 20 **** JSR C_S_CKSUM ; Take second checksum. F927| E0 00 CPX #0 F929| F0** BEQ $10 F92B| F92B| C5 D0 CMP C_S_SUMVL ; If the sums don't match, F92D| D0** BNE $10 ; there's no card. F92F| E4 D1 CPX C_S_SUMVL+1 F931| D0** BNE $10 F933| F933| ; Determine what type of card is in the slot by F933| ; looking at $Cs05 and $Cs07 and comparing values F933| ; to those stored in ID tables. F933| ; Set cardtype as follows F933| ; 0 = Checksum not repeatable or MSB = 0 F933| ; 1 = Checksum repeatable but card not recognized F933| ; 2 = Disk controller card F933| ; 3 = Communications card F933| ; 4 = Serial card F933| ; 5 = Printer card F933| ; 6 = Firmware card F933| ; 7 = Big disk controller card F933| F933| A2 05 LDX #5 ; Start with card type 5. F935| F935| A0 05 $05 LDY #5 ; Check byte Cs05. F937| B1 C5 LDA @C_S_SLTPT,Y F939| DD **** CMP SIG1-C_S_OFFSET-2,X ; Match table? F93C| D0** BNE $06 ; No--try next. F93E| F93E| C9 03 CMP #3 ; Checking for disk? F940| F0** BEQ $08 ; Yes--special handling. F942| F942| A0 07 LDY #7 ; Check byte Cs07. F944| B1 C5 LDA @C_S_SLTPT,Y F946| DD **** CMP SIG2-C_S_OFFSET-2,X ; Match table? F949| F0** BEQ $07 ; Yes--card recognized! F94B| F94B| ; Try next slot type. F94B| CA $06 DEX ; Decrement ID number. F94C| E0 02 CPX #2 ; If not in list, fall F94E| B0E5 BCS $05 ; through with X = 1. F950| F950| E0 04 $07 CPX #4 ; Is it a serial card? F952| D0** BNE $09 ; Yes--can't do further test. F954| F954| A0 0B LDY #0B ; Check $Cs0B. F956| B1 C5 LDA @C_S_SLTPT,Y F958| C9 01 CMP #1 ; If = 1, F95A| D0** BNE $09 F95C| A2 06 LDX #6 ; change to firmware type. F95E| D0** BNE $09 F960| F960| ; Check type of disk card. F960| A0 01 $08 LDY #1 ; Check $Cs01. F962| B1 C5 LDA @C_S_SLTPT,Y F964| C9 20 CMP #020 ; If <> 020, F966| D0E3 BNE $06 ; not a disk. F968| F968| A0 03 LDY #3 ; Check $Cs03 F96A| B1 C5 LDA @C_S_SLTPT,Y F96C| C9 00 CMP #0 ; If <> 0, F96E| D0DB BNE $06 ; not a disk. F970| F970| A0 FF LDY #0FF ; Check $CsFF. F972| B1 C5 LDA @C_S_SLTPT,Y ;If = 0, F974| F0** BEQ $09 ; regular disk. F976| F976| A0 FE LDY #0FE ; Check $CsFE. F978| B1 C5 LDA @C_S_SLTPT,Y F97A| 29 03 AND #3 ; If bits 0, 1 clear, F97C| F0CD BEQ $06 ; not a disk. F97E| F97E| ; Special type of disk (big). F97E| A9 80 LDA #128. F980| 8D 33BF STA DSK_FLG F983| A2 07 LDX #7 F985| F985| A4 C6 $09 LDY C_S_SLTPT+1 F987| 8A TXA F988| 99 67BE STA SLTTYPS-0C0,Y ; Store slot type value. F98B| F98B| A4 C6 $10 LDY C_S_SLTPT+1 F98D| 88 DEY ; Decrement slot number. F98E| C0 C0 CPY #0C0 ; If not down to 0, F990| D089 BNE $04 ; check the next slot. F992| F992| ; Slot types have been recorded. Now set up some values. F992| F992| AE 2ABF LDX SLTTYPS+3 ; Get slot type of video. F995| 8E 0EBF STX SCRMODE ; Store in SCRMODE. F998| A9 00 LDA #0 ; Set slot type F99A| 8D 2ABF STA SLTTYPS+3 ; to 0 temporarily. F99D| F99D| A0 03 LDY #3 ; Move JSR KCONCK F99F| D0** BNE LF9A5 F9A1| F9A1| 20 **** JSRCONCK JSR KCONCK F9A4| 60 RTS F9A5| F9A5| B9 A1F9 LF9A5 LDA JSRCONCK,Y F9A8| 99 0ABF STA CONCKVECTOR,Y F9AB| 88 DEY F9AC| 10F7 BPL LF9A5 F9AE| F9AE| ; Move zero page pointers: F9AE| A0 07 LDY #7 ; E8/E9 = UDJVP F9B0| B9 **** LF9B0 LDA ZP_VEC,Y ; EA/EB = DISKNUMP F9B3| 99 E8 00 STA UDJVP,Y ; EC/ED = JVBFOLD F9B6| 88 DEY ; EE/EF = JVAFOLD F9B7| 10F7 BPL LF9B0 F9B9| F9B9| A9 80 LDA #128. ; Set downshift flag. F9BB| 85 E1 STA DSMODE F9BD| F9BD| AD 51C0 LDA SETTXTMODE ; Set text mode F9C0| AD 52C0 LDA SETALLGRAPH ; all text (no graphics) F9C3| AD 54C0 LDA TXTPAGE1 ; primary page F9C6| AD 57C0 LDA SETHIRES ; high-res graphics. F9C9| AD 10C0 LDA KBDSTRB ; Clear keyboard strobe F9CC| 8D 0FC0 STA SETALTCHAR ; and keyboard data. F9CF| AD 83C0 LDA LCBANK2 ; Read bank 2 RAM (BIOS). F9D2| F9D2| AD **** LDA LF9F8+1 F9D5| 48 PHA F9D6| AD **** LDA LF9F8 F9D9| 48 PHA F9DA| 6C **** JMP @TO_FORM ; Home cursor, clear display. F9DD| AD **** LF9DD LDA LF9FA+1 F9E0| 48 PHA F9E1| AD **** LDA LF9FA F9E4| 48 PHA F9E5| 6C **** JMP @TO_INV ; Invert cursor. F9E8| AD **** LF9E8 LDA LF9FC+1 F9EB| 48 PHA F9EC| AD **** LDA LF9FC F9EF| 48 PHA F9F0| 6C **** JMP @TO_CKDSK ; Check for disk cards. F9F3| AD 8BC0 LF9F3 LDA LCBANK1 ; Choose bank 2 of RAM. F9F6| D0** BNE LF9FE F9F8| F9F8| ; These are return addresses pushed onto the stack F9F8| ; before jumping into BIOS subroutines. F9F8| ED68 LF9F8 .WORD LF9DD-C_S_OFFSET-1 ; 068ED F9FA| F868 LF9FA .WORD LF9E8-C_S_OFFSET-1 ; 068F8 F9FC| 0369 LF9FC .WORD LF9F3-C_S_OFFSET-1 ; 06903 F9FE| F9FE| ; Determine CPU type and set loc $BF31 as follows F9FE| ; System Bit 7 Bit 6 Bit 5 Bit 1 Bit 0 Byte F9FE| ; //c 1 1 0 1 1 $C3 F9FE| ; //e 1 0 0 0 0 $80 F9FE| ; w/80-col 1 0 0 0 1 $81 F9FE| ; w/128K 1 0 0 1 1 $83 F9FE| ; new (//GS?) 1 0 1 1 1 $A3 F9FE| ; ][ or ][+ 0 0 0 0 0 $00 F9FE| F9FE| ; CPU type is determined by looking at ROM locations F9FE| ; System ROM_VERSION ($FBB3) ROM_IDBYTE ($FBC0) F9FE| ; ][ $38 F9FE| ; ][+ $EA F9FE| ; //e (orig) $06 $EA F9FE| ; //e (enh) $06 $E0 F9FE| ; //c $06 $00 F9FE| F9FE| AD 81C0 LF9FE LDA ROMIN ; Read ROM and FA01| AD 81C0 LDA ROMIN ; write-enable RAM. FA04| AD B3FB LDA ROM_VERSION ; Get ROM bytes FA07| AC C0FB LDY ROM_IDBYTE ; into A and Y. FA0A| AE 8BC0 LDX LCBANK1 ; Read bank 2 of RAM FA0D| AE 8BC0 LDX LCBANK1 ; and write-enable. FA10| FA10| A2 80 LDX #080 ; Load //e value into X-reg. FA12| C9 06 CMP #6 ; If this a "new" machine, FA14| F0** BEQ $01 ; determine which one. FA16| FA16| ; System must be ][ or ][+ FA16| AD 61C0 LDA BUTN0 ; If button 1 is off, FA19| 30** BMI $05 FA1B| 8E 11BF STX CHKBUT0 ; set flag to TRUE. FA1E| 10** BPL $05 FA20| FA20| FA20| ; Computer version = 6: it's a //e or //c! FA20| 8E 11BF $01 STX CHKBUT0 ; Set button 0 flag = TRUE. FA23| FA23| 98 TYA ; Move version to A-reg. FA24| 29 F0 AND #0F0 ; Isolate left nybble. FA26| C9 E0 CMP #0E0 ; If this is a //e, FA28| F0** BEQ $03 ; go to its block of code. FA2A| C9 00 CMP #0 ; If this is a //c, FA2C| F0** BEQ $02 ; go to its block of code. FA2E| FA2E| ; ID of computer is not ][, ][+, //e, or //c! FA2E| A9 A3 LDA #0A3 FA30| 30** BMI $04 FA32| FA32| ; ID of computer is //c FA32| A9 C3 $02 LDA #0C3 FA34| 30** BMI $04 FA36| FA36| ; ID of computer is //e (or enhanced //e) FA36| 8E 31BF $03 STX COMPTYPE FA39| A9 83 LDA #083 ; Determine if this FA3B| 8D 09C0 STA SETALTZP ; //e has 80-col card FA3E| 8D 00F8 STA 0F800 ; and 128K memory. FA41| A9 81 LDA #081 FA43| 8D 00FC STA 0FC00 FA46| AD 00F8 LDA 0F800 FA49| 8D 08C0 STA SETSTDZP FA4C| C9 83 CMP #083 FA4E| F0** BEQ $04 FA50| C9 81 CMP #081 FA52| D0** BNE $05 FA54| FA54| 8D 31BF $04 STA COMPTYPE FA57| FA57| FA57| FA57| A9 02 $05 LDA #2 ; Clear STOP, FLUSH, and FA59| 85 FA STA CONFLGS ; Follow Cursor flags. FA5B| FA5B| A2 FF LDX #0FF ; Reset stack pointer. FA5D| 9A TXS FA5E| FA5E| D8 CLD ; Get rid of decimal mode. FA5F| FA5F| AD CBF4 LDA A_IBU ; Store more pointers... FA62| 8D 1DBF STA IBREAK FA65| AD CCF4 LDA A_IBU+1 FA68| 8D 1EBF STA IBREAK+1 ; IBREAK FA6B| FA6B| AD 45F8 LDA A_XIT FA6E| 8D 2FBF STA XITLOC FA71| AD 46F8 LDA A_XIT+1 FA74| 8D 30BF STA XITLOC+1 ; XITLOC FA77| FA77| AD 43F8 LDA A_SYSCOM FA7A| 8D 1FBF STA ISYSCOM FA7D| AD 44F8 LDA A_SYSCOM+1 FA80| 8D 20BF STA ISYSCOM+1 ; ISYSCOM FA83| FA83| A9 40 LDA #64. ; Flavor is 128K run-time. FA85| 8D 22BF STA FLAVOR FA88| FA88| A9 04 LDA #4 ; Version is 1.3 FA8A| 8D 21BF STA VERSION FA8D| FA8D| AD BFF8 LDA A_WTBL ; Set Write Table pointer. FA90| 85 E6 STA WTPTR FA92| AD C0F8 LDA A_WTBL+1 FA95| 85 E7 STA WTPTR+1 FA97| FA97| AD C1F8 LDA A_RTBL ; Set Read Table pointer. FA9A| 85 E4 STA RTPTR FA9C| AD C2F8 LDA A_RTBL+1 FA9F| 85 E5 STA RTPTR+1 FAA1| FAA1| AD 4BF8 LDA LOWEST_CODE ; Lowest code address FAA4| 85 62 STA CODELOW ; = $800. FAA6| AD 4CF8 LDA LOWEST_CODE+1 FAA9| 85 63 STA CODELOW+1 FAAB| FAAB| A9 00 LDA #0 ; $64/65 and $66/67 FAAD| 85 64 STA Z64 ; = $D000 FAAF| 85 66 STA Z66 FAB1| A9 D0 LDA #0D0 FAB3| 85 65 STA Z64+1 FAB5| 85 67 STA Z66+1 FAB7| FAB7| ; Move 41 bytes to $BF56, then set up pointer to it. FAB7| ; (Could this be the "FORTRAN protect" area?) FAB7| A0 29 LDY #41. FAB9| B9 **** $06 LDA LFADD,Y FABC| 99 56BF STA FTNPRO,Y FABF| 88 DEY FAC0| 10F7 BPL $06 FAC2| A9 56 LDA #056 FAC4| 8D 23BF STA A_FTNPRO FAC7| A9 BF LDA #0BF FAC9| 8D 24BF STA A_FTNPRO+1 FACC| FACC| AD **** LDA DISKNUM+7 ; If unit # 4 is non-standard, FACF| F0** BEQ LFB07 FAD1| A2 02 LDX #2 ; function = init FAD3| A9 04 LDA #4 ; unit # = 4 FAD5| A0 08 LDY #8 FAD7| 20 **** JSR KPSUBD ; call the disk driver FADA| 18 CLC FADB| 90** BCC LFB0C ; go to rest of disk access. FADD| FADD| ; These bytes are moved to $BF56. Is it "FORTRAN protect?" FADD| C0 D2 5C LFADD .BYTE 0C0,0D2,05C FAE0| D5 7A D3 0F D2 20 B3 .BYTE 0D5,07A,0D3,00F,0D2,020,0B3,0B3,0A5,046,085,04C,0B3,0B3,04C,0B3 FAE7| B3 A5 46 85 4C B3 B3 FAEE| 4C B3 FAF0| B3 0E 49 AB 45 CD 48 .BYTE 0B3,00E,049,0AB,045,0CD,048,04A,068,02A,0C9,004,02A,085,046,060 FAF7| 4A 68 2A C9 04 2A 85 FAFE| 46 60 FB00| A4 46 24 00 4C 10 D3 .BYTE 0A4,046,024,000,04C,010,0D3 FB07| FB07| FB07| ; The disk uses the standard BIOS driver. FB07| A9 04 LFB07 LDA #4 ; Call DINIT for drive 4. FB09| 20 **** JSR LFF15 FB0C| FB0C| ; Clear $1E0 bytes of memory in SYSCOM. FB0C| A9 00 LFB0C LDA #0 FB0E| AA TAX FB0F| 9D 1EBD $01 STA IORSLT,X FB12| E8 INX FB13| D0FA BNE $01 FB15| 9D 1EBE $02 STA IORSLT+0100,X FB18| E8 INX FB19| E0 E0 CPX #0E0 FB1B| D0F8 BNE $02 FB1D| FB1D| ; Read the directory from unit 4. FB1D| A9 00 LDA #0 FB1F| 48 PHA ; Mode = 0 FB20| 48 PHA FB21| 48 PHA ; Unitnumber = 4 FB22| AD **** LDA DISKNUM+7 FB25| F0** BEQ $03 FB27| A9 04 LDA #4 FB29| 10** BPL $04 FB2B| AD **** $03 LDA DISKNUM+6 FB2E| 48 $04 PHA ; Array address = $6000 FB2F| A9 60 LDA #060 FB31| 48 PHA FB32| 85 8B STA C_S_RDPT+1 ; (Store address in FB34| A9 00 LDA #0 ; C_S_RDPT also.) FB36| 48 PHA FB37| 85 8A STA C_S_RDPT FB39| A9 08 LDA #8 ; Length = $800 FB3B| 48 PHA FB3C| A9 00 LDA #0 FB3E| 48 PHA FB3F| 48 PHA ; Blocknumber = 2 FB40| A9 02 LDA #2 FB42| 48 PHA FB43| FB43| AD **** LDA DISKNUM+7 ; Check for BIOS or FB46| F0** BEQ $05 ; attached driver. FB48| FB48| A2 00 LDX #0 ; Function = read FB4A| A9 04 LDA #4 ; Unit = 4 FB4C| A0 08 LDY #8 FB4E| 20 **** JSR KPSUBD ; Call attached driver. FB51| 18 CLC FB52| 90** BCC $06 FB54| FB54| 20 **** $05 JSR LFF12 ; Call BIOS DREAD FB57| FB57| ; See if the "ignore external terminal" bit is set. FB57| AD 1960 $06 LDA C_S_BUFFR+25. ; Get last byte of directory. FB5A| 29 08 AND #8 ; Isolate bit 3. FB5C| D0** BNE $07 ; Yes, it's set. FB5E| 2C 31BF BIT COMPTYPE ; If bit 6 of COMPTYPE is set FB61| 50** BVC $08 ; (//c), FB63| AD 60C0 LDA 0C060 ; check a different byte! FB66| 10** BPL $08 FB68| ; Bit is set. Screen mode is 40 cols no matter what! FB68| A9 00 $07 LDA #0 FB6A| F0** BEQ $09 FB6C| FB6C| AD 0EBF $08 LDA SCRMODE ; Restore the slot type FB6F| 8D 2ABF STA SLTTYPS+3 ; for slot number 3. FB72| A0 30 LDY #030 ; Set up slot #3 for GENIT. FB74| AE 83C0 LDX LCBANK2 ; Fold in BIOS RAM. FB77| 20 C3F8 JSR TO_GENIT ; Init serial card via GENIT. FB7A| AD 8BC0 LDA LCBANK1 ; Fold in interpreter RAM. FB7D| A9 00 LDA #0 FB7F| E0 00 CPX #0 FB81| D0** BNE $09 FB83| A9 04 LDA #4 FB85| 8D 0EBF $09 STA SCRMODE ; Set the screen mode. FB88| FB88| AD 31BF LDA COMPTYPE ; Get computer type. FB8B| 29 02 AND #2 ; If 128K flag is set, FB8D| D0** BNE CS_CHKDIR ; keep on with cold boot. FB8F| FB8F| FB8F| ; This is a 128K SYSTEM.PASCAL, but the computer has only FB8F| ; 64K. Print the error message and wait for RESET. FB8F| FB8F| A8 TAY ; Init char count. FB90| 8C 4AF8 STY M_CH_CNT FB93| B9 A9F8 $10 LDA NEED_128_MSG,Y ; Get character from message. FB96| C9 23 CMP #"#" ; When end of message is found, FB98| F0FE $11 BEQ $11 ; wait forever! FB9A| 20 **** JSR LFF03 ; Call CWRITE. FB9D| EE 4AF8 INC M_CH_CNT ; Bump character count. FBA0| AC 4AF8 LDY M_CH_CNT FBA3| 18 CLC FBA4| 90ED BCC $10 ; Stay in loop until done. FBA6| FBA6| FBA6| FBA6| CS_CHKDIR FBA6| A2 4E LDX #78. ; There are 78 directory entries. FBA8| A9 60 LDA #060 ; They start at $6000. FBAA| 85 8B STA C_S_RDPT+1 FBAC| A9 00 LDA #0 FBAE| 85 8A STA C_S_RDPT FBB0| 18 CLC ; Add 6 to pointer to FBB1| A5 8A LDA C_S_RDPT ; get to file name. FBB3| 69 06 ADC #6 FBB5| 85 8A STA C_S_RDPT FBB7| 90** BCC $02 FBB9| E6 8B INC C_S_RDPT+1 FBBB| FBBB| 18 $01 CLC ; Add 26 to pointer to FBBC| A5 8A LDA C_S_RDPT ; get to next directory FBBE| 69 1A ADC #26. ; entry. FBC0| 85 8A STA C_S_RDPT FBC2| 90** BCC $02 FBC4| E6 8B INC C_S_RDPT+1 FBC6| CA $02 DEX ; Decrement the directory count. FBC7| D0** BNE $06 ; If not at 0, check this entry. FBC9| FBC9| FBC9| ; All entries have been checked, but there is no file FBC9| ; SYSTEM.PASCAL. Tell user to put a new disk in, then FBC9| ; wait for key. FBC9| FBC9| 8A TXA FBCA| 85 A1 STA UN_DLF+1 ; Clear DLE flag FBCC| 85 A2 STA UN_DLF+2 ; for units 1 & 2. FBCE| AD CCF4 LDA A_IBU+1 ; Push CONSOLE: FBD1| 48 PHA ; initialization FBD2| AD CBF4 LDA A_IBU ; parameters. FBD5| 48 PHA FBD6| AD 44F8 LDA A_SYSCOM+1 ; Puss address FBD9| 48 PHA ; of SYSCOM. FBDA| AD 43F8 LDA A_SYSCOM FBDD| 48 PHA FBDE| 20 **** JSR LFF06 ; Call CINIT. FBE1| FBE1| A0 00 LDY #0 FBE3| 8C 4AF8 STY M_CH_CNT FBE6| FBE6| ; Print the message telling user to put proper FBE6| ; disk into drive and press key. FBE6| B9 4FF8 $03 LDA INSRT_MSG,Y ; Get next message char. FBE9| C9 23 CMP #"#" ; Check for end. FBEB| D0** BNE $05 FBED| AD 49F8 LDA WAIT_CNT FBF0| D0** BNE $04 FBF2| EE 49F8 INC WAIT_CNT FBF5| FBF5| ; Wait for user to press key. FBF5| AD 00C0 $04 LDA KBD FBF8| 10FB BPL $04 FBFA| 8D 10C0 STA KBDSTRB FBFD| 29 7F AND #127. FBFF| C9 0D CMP #13. FC01| D0F2 BNE $04 FC03| FC03| 6C **** JMP @LFFF8 ; Go to start of interpreter. FC06| FC06| FC06| 20 **** $05 JSR LFF03 ; Call CWRITE. FC09| EE 4AF8 INC M_CH_CNT ; Bump character count. FC0C| AC 4AF8 LDY M_CH_CNT FC0F| 18 CLC FC10| 90D4 BCC $03 ; Print next character. FC12| FC12| FC12| FC12| ; Is this directory entry "SYSTEM.PASCAL"? FC12| AC 8EF8 $06 LDY SYS_PAS_MSG FC15| B1 8A $07 LDA @C_S_RDPT,Y FC17| D9 8EF8 CMP SYS_PAS_MSG,Y FC1A| D09F BNE $01 ; No match--check next entry. FC1C| 88 DEY FC1D| 10F6 BPL $07 ; OK so far; check next char. FC1F| FC1F| ; The SYSTEM.PASCAL directory entry has been found. FC1F| A5 8A LDA C_S_RDPT ; Move pointer back FC21| 38 SEC ; to the beginning FC22| E9 06 SBC #6 ; of directory entry. FC24| 85 8A STA C_S_RDPT FC26| B0** BCS $08 FC28| C6 8B DEC C_S_RDPT+1 FC2A| A0 00 $08 LDY #0 ; Get starting FC2C| B1 8A LDA @C_S_RDPT,Y ; block number. FC2E| 85 84 STA Z84 FC30| C8 INY FC31| B1 8A LDA @C_S_RDPT,Y FC33| 85 85 STA Z84+1 FC35| FC35| A9 00 LDA #0 FC37| 48 PHA ; Mode = 0 FC38| 48 PHA FC39| 48 PHA ; Unit # = 4 FC3A| AD **** LDA DISKNUM+7 FC3D| F0** BEQ $09 FC3F| A9 04 LDA #4 FC41| 10** BPL $10 FC43| AD **** $09 LDA DISKNUM+6 FC46| 48 $10 PHA ; Read address = $6000 FC47| A9 60 LDA #060 FC49| 48 PHA FC4A| A9 00 LDA #0 FC4C| 48 PHA FC4D| A9 02 LDA #2 ; Length = $200 FC4F| 48 PHA FC50| A9 00 LDA #0 FC52| 48 PHA FC53| A5 85 LDA Z84+1 ; Starting block is FC55| 48 PHA ; from directory entry. FC56| A5 84 LDA Z84 FC58| 48 PHA FC59| AD **** LDA DISKNUM+7 FC5C| F0** BEQ $11 FC5E| FC5E| A2 00 LDX #0 FC60| A9 04 LDA #4 FC62| A0 08 LDY #8 FC64| 20 **** JSR KPSUBD ; Call attached driver. FC67| 18 CLC FC68| 90** BCC $12 FC6A| FC6A| 20 **** $11 JSR LFF12 ; or call DREAD BIOS driver. FC6D| FC6D| FC6D| FC6D| A9 00 $12 LDA #0 ; Clear the segment FC6F| AA TAX ; usage count table. FC70| 9D 9EBB $13 STA SEG_CALL,X FC73| E8 INX FC74| E0 80 CPX #128. FC76| D0F8 BNE $13 FC78| FC78| AD 41F8 LDA A_SEGTB2 ; $7E/7F = addr of FC7B| 85 7E STA Z7E ; Segment Dictiionary FC7D| AD 42F8 LDA A_SEGTB2+1 ; table. FC80| 85 7F STA Z7E+1 FC82| FC82| A9 61 LDA #061 ; $80/81 = addr of FC84| 85 81 STA Z80+1 ; SEGINFO field of FC86| A9 00 LDA #0 ; SYSTEM.PASCAL code file FC88| 85 80 STA Z80 ; segment dictionary (p.IV-23). FC8A| FC8A| A0 03 LDY #3 ; Isolate compiler version FC8C| B1 80 LDA @Z80,Y ; field in code dictionary. FC8E| C6 81 DEC Z80+1 FC90| 29 E0 AND #0E0 FC92| C9 C0 CMP #0C0 ; If not = 6 (vers 1.3), error! FC94| F0** BEQ $16 FC96| FC96| ; The SYSTEM.PASCAL file is not version 1.3. FC96| A0 00 LDY #0 FC98| 8C 4AF8 STY M_CH_CNT FC9B| B9 8EF8 $14 LDA SYS_PAS_MSG,Y ; Get next message char. FC9E| C9 23 CMP #"#" ; If it's the end flag, FCA0| F0FE $15 BEQ $15 ; wait here forever. FCA2| 20 **** JSR LFF03 ; Call CWRITE. FCA5| EE 4AF8 INC M_CH_CNT ; Bump character count. FCA8| AC 4AF8 LDY M_CH_CNT FCAB| 10EE BPL $14 FCAD| FCAD| ; Use code file dictionary to set system dictionary. FCAD| A2 10 $16 LDX #16. ; 16 entries. FCAF| A0 00 LFCAF LDY #0 FCB1| A9 04 LDA #4 ; Disk unit # = 4. FCB3| 91 7E STA @Z7E,Y FCB5| 98 TYA FCB6| C8 INY FCB7| 91 7E STA @Z7E,Y FCB9| A5 7E LDA Z7E FCBB| 18 CLC FCBC| 69 02 ADC #2 ; Bump $7E/7F to FCBE| 85 7E STA Z7E ; next word FCC0| 90** BCC $18 ; (starting FCC2| E6 7F INC Z7E+1 ; block num). FCC4| A0 00 $18 LDY #0 FCC6| 18 CLC FCC7| B1 80 LDA @Z80,Y FCC9| 65 84 ADC Z84 FCCB| 91 7E STA @Z7E,Y FCCD| C8 INY FCCE| B1 80 LDA @Z80,Y FCD0| 65 85 ADC Z84+1 FCD2| 91 7E STA @Z7E,Y FCD4| C8 INY FCD5| B1 80 LDA @Z80,Y FCD7| 91 7E STA @Z7E,Y FCD9| C8 INY FCDA| B1 80 LDA @Z80,Y FCDC| 91 7E STA @Z7E,Y FCDE| A5 7E LDA Z7E FCE0| 18 CLC FCE1| 69 04 ADC #4 ; Bump $7E/7F to FCE3| 85 7E STA Z7E ; next entry FCE5| 90** BCC $19 ; (2 words). FCE7| E6 7F INC Z7E+1 FCE9| A5 80 $19 LDA Z80 FCEB| 18 CLC FCEC| 69 04 ADC #4 ; Also bump $80/81. FCEE| 85 80 STA Z80 FCF0| 90** BCC $20 FCF2| E6 81 INC Z80+1 FCF4| CA $20 DEX ; Stay in loop until FCF5| D0B8 BNE LFCAF ; all entries set. FCF7| FCF7| FCF7| AD 4DF8 LDA HIGHEST_CODE ; Initialize CODEP FCFA| 85 60 STA CODEP ; to $0C000. FCFC| AD 4EF8 LDA HIGHEST_CODE+1 FCFF| 85 61 STA CODEP+1 FD01| FD01| AD 3FF8 LDA A_STKSTR ; Initialize KP, FD04| 85 5C STA KP ; MP, and ENDSTK FD06| 85 52 STA MP ; to $BB5C. FD08| 8D 32BD STA ENDSTK FD0B| AD 40F8 LDA A_STKSTR+1 FD0E| 85 5D STA KP+1 FD10| 85 53 STA MP+1 FD12| 8D 33BD STA ENDSTK+1 FD15| FD15| A9 0C LDA #0C ; Init NP=$0C00. FD17| 85 5B STA NP+1 FD19| FD19| A9 0F LDA #15. ; Read seg 15. FD1B| 20 84E6 JSR READSEG FD1E| FD1E| A5 60 LDA CODEP FD20| 85 76 STA Z76 FD22| A5 61 LDA CODEP+1 FD24| 85 77 STA Z76+1 FD26| FD26| A9 FD LDA #0FD FD28| 85 61 STA CODEP+1 FD2A| A9 FC LDA #0FC FD2C| 85 60 STA CODEP FD2E| FD2E| A9 00 LDA #0 ; Load seg 0. FD30| 20 CDE7 JSR LOADSEG FD33| FD33| A5 76 LDA Z76 FD35| 85 60 STA CODEP FD37| A5 77 LDA Z76+1 FD39| 85 61 STA CODEP+1 FD3B| FD3B| A9 01 LDA #1 FD3D| 85 82 STA PROCNUM FD3F| 20 47E2 JSR CXPUTIL FD42| FD42| ; Build the first MARKSTACK record... FD42| A0 00 LDY #0 FD44| A5 52 LDA MP FD46| 85 50 STA BASE ; BASE register, FD48| 91 52 STA @MP,Y ; Static chain, and FD4A| A0 02 LDY #2 ; dynamic chain FD4C| 91 52 STA @MP,Y ; all point to FD4E| A5 53 LDA MP+1 ; this record! FD50| 85 51 STA BASE+1 FD52| 88 DEY FD53| 91 52 STA @MP,Y FD55| A0 03 LDY #3 FD57| 91 52 STA @MP,Y FD59| A0 0C LDY #12. FD5B| AD 43F8 LDA A_SYSCOM ; Store address of SYSCOM. FD5E| 91 52 STA @MP,Y FD60| C8 INY FD61| AD 44F8 LDA A_SYSCOM+1 FD64| 91 52 STA @MP,Y FD66| FD66| AD 0EBF LDA SCRMODE ; If bit 2 of SCRMODE is set, FD69| 29 04 AND #4 ; bottom of heap starts FD6B| F0** BEQ $21 FD6D| A9 08 LDA #8 ; at $0804, FD6F| 85 5B STA NP+1 FD71| 10** BPL $22 FD73| A9 0C $21 LDA #0C ; else at $0C04. FD75| 85 5B STA NP+1 FD77| A9 04 $22 LDA #4 FD79| 85 5A STA NP FD7B| FD7B| A2 01 LDX #1 FD7D| 86 71 STX 0071 FD7F| CA DEX FD80| 8A TXA FD81| 95 A0 $23 STA UN_DLF,X FD83| E8 INX FD84| E0 0D CPX #13. FD86| D0F9 BNE $23 FD88| FD88| A9 04 LDA #4 FD8A| 8D 22BD STA SYSUNIT FD8D| D0** BNE LFDAD FD8F| FD8F| ;--------------------------------------------------- FD8F| ; Cold Start Checksum subroutine: total up the FD8F| ; values of the page pointed to by C_S_SLTPT. FD8F| ; Result returned in A- and X- registers. FD8F| ;--------------------------------------------------- FD8F| C_S_CKSUM FD8F| A9 00 LDA #0 FD91| AA TAX FD92| A8 TAY FD93| FD93| 18 $01 CLC FD94| 71 C5 ADC @C_S_SLTPT,Y FD96| 90** BCC $02 FD98| E8 INX FD99| C8 $02 INY FD9A| D0F7 BNE $01 FD9C| FD9C| 60 RTS FD9D| FD9D| FD9D| ; Signature bytes to check I/O card types FD9D| 03 18 38 48 SIG1 .BYTE 003,018,038,048 ; value in $Cs05 FDA1| 3C 38 18 48 SIG2 .BYTE 03C,038,018,048 ; value in $Cs07 FDA5| ; Type = 2 3 4 6 FDA5| ; Disk Com Serl Firmware FDA5| FDA5| ; These pointers are moved to 0E8..0EF FDA5| **** ZP_VEC .WORD UDJMPVEC FDA7| **** .WORD DISKNUM FDA9| **** .WORD BIOS FDAB| **** .WORD BIOSAF FDAD| FDAD| FDAD| ;--------------------------------------------------- FDAD| ; End of Cold Start code: clear memory from $06000 FDAD| ; to 06CC7, to jump to main loop. FDAD| ;--------------------------------------------------- FDAD| A2 60 LFDAD LDX #060 FDAF| 86 BE STX C_S_PNT+1 FDB1| A9 00 LDA #0 FDB3| 85 BD STA C_S_PNT FDB5| A8 TAY FDB6| C0 C7 $01 CPY #0C7 FDB8| D0** BNE $02 FDBA| FDBA| E0 6C CPX #06C FDBC| F0** BEQ $03 FDBE| FDBE| 91 BD $02 STA @C_S_PNT,Y FDC0| C8 INY FDC1| D0F3 BNE $01 FDC3| E6 BE INC C_S_PNT+1 FDC5| E8 INX FDC6| D0EE BNE $01 FDC8| FDC8| 4C B4D2 $03 JMP MAINLOOP FDCB| ;--------------------------------------------------- FDCB| FDCB| ; { The following are not referenced } FDCB| FDCB| 00 00 00 00 00 00 00 .BLOCK 45.,0 FDF8| F8 2D 00 00 02 00 01 LFDF8 .BYTE 0F8,02D,00,00,02,00,01,01 FDFF| 01 FE00| FE00| .PAGE FE00| 0000 A_INTDV1 .WORD 0 ; Points to first interrupt dvr. FE02| FE02| FE02| ;--------------------------------------------------- FE02| ; Interrupt Manager FE02| ;--------------------------------------------------- FE02| 8D **** IM STA IM_AREG ; Hold the A-reg. FE05| 68 PLA ; Get status before int. FE06| 48 PHA ; (and put it back). FE07| 29 10 AND #16. ; If BRK flag set, FE09| D0** BNE DO_RESET ; go do a reset! FE0B| FE0B| AD **** LDA IM_AREG ; Save A-reg, FE0E| 48 PHA FE0F| 8A TXA ; X-reg, FE10| 48 PHA FE11| 98 TYA ; Y-reg, FE12| 48 PHA FE13| AD 13C0 LDA RDRAMRD ; main/aux read switch FE16| 48 PHA ; on stack. FE17| 8D 02C0 STA RDMAINRAM ; Read from main RAM. FE1A| AD 14C0 LDA RDRAMWRT ; Save main aux write switch. FE1D| 48 PHA FE1E| 8D 04C0 STA WRMAINRAM ; Write to main RAM. FE21| AD 11C0 LDA RDLCBNK2 ; Save RAM bank #. FE24| 48 PHA FE25| AD 8BC0 LDA LCBANK1 ; Read 1st 4K bank of RAM. FE28| AD **** LDA A_IM_RST+1 ; Push address of FE2B| 48 PHA ; IM_RESET onto stack FE2C| AD **** LDA A_IM_RST ; (that's where driver FE2F| 48 PHA ; RTIs to when done). FE30| AD 1CC0 LDA RDPAGE2 ; Read page1/2 switch. FE33| 8D 54C0 STA TXTPAGE1 ; Display primary page. FE36| 0A ASL A ; Move page flag to carry. FE37| AD 15C0 LDA RDCXROM ; Read internal/slot switch. FE3A| 08 PHP ; Push status. FE3B| AD F807 LDA 007F8 ; Get the active I/O slot # FE3E| 8D **** STA IM_SLOTN ; and save in memory. FE41| 8D 06C0 STA SETSLOTCSROM ;Use internal ROM at $Cn00. FE44| 6C 00FE JMP @A_INTDV1 ; Jump into the first driver. FE47| FE47| FE47| 6C **** DO_RESET JMP @LFFFC ; Take the Reset vector. FE4A| FE4A| FE4A| ;--------------------------------------------------- FE4A| ; Interrupt reset code. FE4A| ;--------------------------------------------------- FE4A| 90** IM_RESET BCC $01 ; If carry bit is set, FE4C| 8D 55C0 STA TXTPAGE2 ; display secondary page. FE4F| 10** $01 BPL $02 FE51| 8D 07C0 STA SETINTCXROM ; Use slot ROM at $Cx00. FE54| 68 $02 PLA ; Get keyboard strobe byte. FE55| 10** BPL $03 ; If sign bit set, FE57| AD 83C0 LDA LCBANK2 ; use RAM bank 2 FE5A| 68 $03 PLA FE5B| 10** BPL $04 ; Restore main/aux FE5D| 8D 05C0 STA WRCARDRAM ; RAM status. FE60| 68 $04 PLA FE61| 10** BPL $05 FE63| 8D 03C0 STA RDCARDRAM FE66| AD **** $05 LDA IM_SLOTN ; Get slot indicator FE69| 8D **** STA $06+2 ; and re-enable ROM. FE6C| AD FFCF LDA 0CFFF FE6F| AD FFC0 $06 LDA 0C0FF FE72| 68 PLA ; Restore FE73| A8 TAY ; Y-reg, FE74| 68 PLA FE75| AA TAX ; X-reg, FE76| 68 PLA ; A-reg. FE77| 40 RTI ; Restore status & go back. FE78| FE78| FE78| 4AFE A_IM_RST .WORD IM_RESET FE7A| FE7A| 00 IM_AREG .BYTE 0 FE7B| FE7B| IM_SLOTN FE7B| 00 00 00 00 00 .BYTE 0,0,0,0,0 FE80| FE80| FE80| .PAGE FE80| ;--------------------------------------------------- FE80| ; UDJMVEC: Jump Vector for user devices FE80| ; The actual driver addresses are filled in by FE80| ; SYSTEM.ATTACH at startup time. An address of 0 FE80| ; (default) indicates an unattached device. FE80| ;--------------------------------------------------- FE80| UDJMPVEC FE80| 4C 0000 JMP 00000 ; Unit # 128 (usually hard disk) FE83| 4C 0000 JMP 00000 ; Unit # 129 (usually Mouse) FE86| 4C 0000 JMP 00000 ; Unit # 130 FE89| 4C 0000 JMP 00000 FE8C| 4C 0000 JMP 00000 FE8F| 4C 0000 JMP 00000 FE92| 4C 0000 JMP 00000 FE95| 4C 0000 JMP 00000 FE98| 4C 0000 JMP 00000 FE9B| 4C 0000 JMP 00000 FE9E| 4C 0000 JMP 00000 FEA1| 4C 0000 JMP 00000 FEA4| 4C 0000 JMP 00000 FEA7| 4C 0000 JMP 00000 FEAA| 4C 0000 JMP 00000 FEAD| 4C 0000 JMP 00000 ; Unit # 143 FEB0| FEB0| FEB0| ;--------------------------------------------------- FEB0| ; DISKNUM: Information on units 1 .. 20. FEB0| ; If high order byte = FF then FEB0| ; device is not a disk drive (or not attached). FEB0| ; IF high order byte = 0 then FEB0| ; device is a regular disk drive and FEB0| ; low byte = drive number. FEB0| ; If high order byte = anything else then FEB0| ; the word has been stored by SYSTEM.ATTACH and FEB0| ; contains the driver's address minus 1. FEB0| ;--------------------------------------------------- FEB0| FFFF DISKNUM .WORD 0FFFF ; Unit 1 = CONSOLE: FEB2| FFFF .WORD 0FFFF ; Unit 2 = SYSTERM: FEB4| FFFF .WORD 0FFFF ; Unit 3 FEB6| 0000 .WORD 0 ; Unit 4 = startup drive FEB8| 0100 .WORD 1 ; Unit 5 = 2nd disk drive FEBA| FFFF .WORD 0FFFF ; Unit 6 = PRINTER: FEBC| FFFF .WORD 0FFFF ; Unit 7 = REMIN: FEBE| FFFF .WORD 0FFFF ; Unit 8 = REMOUT: FEC0| 0400 .WORD 4 ; Unit 9 = 5th disk drive FEC2| 0500 .WORD 5 ; Unit 10 = 6th disk drive FEC4| 0200 .WORD 2 ; Unit 11 = 3rd disk drive FEC6| 0300 .WORD 3 ; Unit 12 = 4th disk drive FEC8| FFFF .WORD 0FFFF ; Unit 13 = block- FECA| FFFF .WORD 0FFFF ; Unit 14 = structured FECC| FFFF .WORD 0FFFF ; Unit 15 = user FECE| FFFF .WORD 0FFFF ; Unit 16 = devices FED0| FFFF .WORD 0FFFF ; Unit 17 = FED2| FFFF .WORD 0FFFF ; Unit 18 = FED4| FFFF .WORD 0FFFF ; Unit 19 = FED6| FFFF .WORD 0FFFF ; Unit 20 = FED8| FED8| ;--------------------------------------------------- FED8| ; UDRWI: Go to attached driver through UDJMPVEC FED8| ; Entered with unit # in A-reg and driver operation FED8| ; to be performed in X-reg. FED8| ;--------------------------------------------------- FED8| 85 D2 UDRWI STA TT1 FEDA| 0A ASL A FEDB| 0A ASL A FEDC| E5 D2 SBC TT1 FEDE| A8 TAY ; = unit# * 3 FEDF| A9 FE LDA #0FE FEE1| 48 PHA FEE2| 98 TYA FEE3| 4C **** JMP PSUBDR1 ; Finish up with PSUBDRV code. FEE6| FEE6| FEE6| ;--------------------------------------------------- FEE6| ; NMI/Reset/IRQ vectors jump here FEE6| ;--------------------------------------------------- FEE6| AD 8BC0 TOXIT LDA LCBANK1 ; Fold in interpreter. FEE9| 6C 2FBF JMP @XITLOC FEEC| FEEC| FEEC| ;--------------------------------------------------- FEEC| ; Start vector points here FEEC| ;--------------------------------------------------- FEEC| AD 8BC0 TOSTART LDA LCBANK1 ; Fold in interpreter. FEEF| 4C 52D1 JMP INT_START FEF2| FEF2| FEF2| ;--------------------------------------------------- FEF2| ; TOBREAK: Report user break. (from BIOS code) FEF2| ;--------------------------------------------------- FEF2| AD 8BC0 TOBREAK LDA LCBANK1 FEF5| 6C 16BF JMP @BREAK FEF8| FEF8| FEF8| 00 00 00 00 00 00 00 LFEF8 .BYTE 0,0,0,0,0,0,0,0 ; { Not referenced } FEFF| 00 FF00| FF00| ;--------------------------------------------------- FF00| ; Main BIOS jump table called from interpreter FF00| ; (followed by real jump table, BIOSAF, offset by FF00| ; exactly $5C). FF00| ;--------------------------------------------------- FF00| BIOS FF00| 20 **** LFF00 JSR SAVERET ; Call CREAD FF03| 20 **** LFF03 JSR SAVERET ; Call CWRITE FF06| 20 **** LFF06 JSR SAVERET ; Call CINIT FF09| 20 **** LFF09 JSR SAVERET ; Call PWRITE FF0C| 20 **** LFF0C JSR SAVERET ; Call PINIT FF0F| 20 **** LFF0F JSR SAVERET ; Call DWRITE FF12| 20 **** LFF12 JSR SAVERET ; Call DREAD FF15| 20 **** LFF15 JSR SAVERET ; Call DINIT FF18| 20 **** LFF18 JSR SAVERET ; Call RREAD FF1B| 20 **** LFF1B JSR SAVERET ; Call RWRITE FF1E| 20 **** LFF1E JSR SAVERET ; Call RINIT FF21| 20 **** LFF21 JSR SAVERET ; Call IORTS (do nothing) FF24| 20 **** LFF24 JSR SAVERET ; Call GRINIT FF27| 20 **** LFF27 JSR SAVERET ; Call IORTS (do nothing) FF2A| 20 **** LFF2A JSR SAVERET ; Call CSTAT FF2D| 20 **** LFF2D JSR SAVERET ; Call PSTAT (ZEROSTAT) FF30| 20 **** LFF30 JSR SAVERET ; Call DSTATT FF33| 20 **** LFF33 JSR SAVERET ; Call RSTAT (ZEROSTAT) FF36| KCONCK FF36| 20 **** JSR SAVERET ; Call CONCK FF39| KUDRWI FF39| 20 **** JSR SAVERET ; Call UDRWI FF3C| KPSUBD FF3C| 20 **** JSR SAVERET ; Call PSUBDRV FF3F| FF3F| FF3F| ;--------------------------------------------------- FF3F| ; PSUBDRV: Routine to get to an attached driver through DISKNUM FF3F| ; On entry, A-reg = unit #, Y-reg = DISKNUM offset, and FF3F| ; X-reg = command to be performed by the attached driver. FF3F| ;--------------------------------------------------- FF3F| 85 D2 PSUBDRV STA TT1 ; Save unit #. FF41| B9 AFFE LDA DISKNUM-1,Y ; Store MSB of driver addr. FF44| 48 PHA FF45| B9 AEFE LDA DISKNUM-2,Y ; Store LSB of driver addr. FF48| 48 PSUBDR1 PHA ; { UDRWI jumps here! } FF49| A5 D2 LDA TT1 ; Restore unit @. FF4B| 60 RTS ; Jump to attached driver. FF4C| FF4C| FF4C| 00 00 00 00 00 00 .BYTE 0,0,0,0,0,0 FF52| FF52| ; I/O functions called during cold start: FF52| 71DE TO_FORM .WORD FORM ; Home cursor, clear display FF54| C8DA TO_INV .WORD INVERT ; Invert cursor FF56| 4DDD TO_CKDSK .WORD CKDSKSL ; Check slots for disk cards FF58| FF58| FF58| ;--------------------------------------------------- FF58| ; IORTS: Return point for unimplemented instructions FF58| ;--------------------------------------------------- FF58| 60 IORTS RTS FF59| FF59| FF59| 4C 99D8 LFF59 JMP CONCK ; CONCK is in BIOS RAM bank. FF5C| FF5C| FF5C| ;--------------------------------------------------- FF5C| ; Jump table for BIOS JSR table. SYSTEM.ATTACH FF5C| ; modifies the jump addresses to point to attached FF5C| ; drivers for the standard system units. FF5C| ;--------------------------------------------------- FF5C| 4C 3BDB BIOSAF JMP CREAD FF5F| 4C 9FDA JMP CWRITE FF62| 4C F8D9 JMP CINIT FF65| 4C D1DA JMP PWRITE FF68| 4C 27DA JMP PINIT FF6B| 4C 00D0 JMP DWRITE FF6E| 4C 03D0 JMP DREAD FF71| 4C 84DA JMP DINIT FF74| 4C 8ADB JMP RREAD FF77| 4C 01DB JMP RWRITE FF7A| 4C 43DA JMP RINIT FF7D| 4C 58FF JMP IORTS ; Nothing for GRAFIC: write FF80| 4C 3FDA JMP GRINIT FF83| 4C 58FF JMP IORTS ; Nothing for PRINTER: read FF86| 4C CADB JMP CSTAT FF89| 4C FBDB JMP PSTAT FF8C| 4C 68DC JMP DSTATT FF8F| 4C 15DC JMP RSTAT FF92| 4C 99D8 JMP CONCK FF95| 4C D8FE JMP UDRWI FF98| 4C 3FFF JMP PSUBDRV FF9B| FF9B| .PAGE FF9B| ;--------------------------------------------------- FF9B| ; SAVERET: Interpreter's code to jump into the I/O FF9B| ; system. SAVERET stores some return addresses for FF9B| ; a given routine and then folds in the BIOS bank. FF9B| ; The offset to the actual BIOS routine is on top FF9B| ; of the stack when the jump table is called. After FF9B| ; SAVERET folds in the BIOS, it calls SAVERET2, FF9B| ; which does the actual jump, using the offset to FF9B| ; the BIOS routine plus the offset to the second FF9B| ; jump table, which is called BIOSAF. FF9B| ;--------------------------------------------------- FF9B| 85 D2 SAVERET STA TT1 ; Save the A-reg (local return address) FF9D| 68 PLA ; Get offset to the desired routine. FF9E| 18 CLC FF9F| 69 5A ADC #90. ; Add offset to BIOSAF jump table. FFA1| 85 D3 STA TT2 ; Save. FFA3| 68 PLA FFA4| 69 00 ADC #0 FFA6| 85 D4 STA TT3 FFA8| 68 PLA ; Save the 2-byte Pascal FFA9| 8D 1ABF STA RETL ; return addr in RETL/RETH. FFAC| 68 PLA FFAD| 8D 1BBF STA RETH FFB0| AD 83C0 LDA LCBANK2 ; Fold in BIOS code area. FFB3| A5 D2 LDA TT1 ; Restore local return address. FFB5| 20 **** JSR SAVERET2 FFB8| FFB8| FFB8| ;--------------------------------------------------- FFB8| ; GOBACK: return to Pascal interpreter from BIOS. FFB8| ; Fold interpreter back into addres space (Dxxx) FFB8| ; then return to Pascal via return addr saved FFB8| ; in RETL/RETH. FFB8| ;--------------------------------------------------- FFB8| 85 D2 GOBACK STA TT1 ; Save A-reg FFBA| AD 1BBF LDA RETH ; Get Pascal return addr. FFBD| 48 PHA ; saved in RETL/RETH, FFBE| AD 1ABF LDA RETL ; and push onto stack. FFC1| 48 PHA FFC2| AD 8BC0 LDA LCBANK1 ; Fold in interpreter code. FFC5| A5 D2 LDA TT1 ; Restore A-reg FFC7| 60 RTS ; Return to Pascal FFC8| FFC8| FFC8| ;--------------------------------------------------- FFC8| ; SAVERET2: called from SAVERET. FFC8| ;--------------------------------------------------- FFC8| 6C D300 SAVERET2 JMP @TT2 ; Jump through BIOSAF jump table. FFCB| FFCB| FFCB| FFCB| ;--------------------------------------------------- FFCB| ; HTAB: Tab to 2nd half of screen FFCB| ;--------------------------------------------------- FFCB| A5 FB HTAB LDA NLEFT FFCD| C9 14 CMP #20. FFCF| B0** BCS TAB3 FFD1| FFD1| ;--------------------------------------------------- FFD1| ; HTAB1 FFD1| ;--------------------------------------------------- FFD1| A9 28 HTAB1 LDA #40. FFD3| D0** BNE TAB3A FFD5| FFD5| ;--------------------------------------------------- FFD5| ; TAB3: Horizontal shift full left FFD5| ;--------------------------------------------------- FFD5| A9 00 TAB3 LDA #0 FFD7| 38 TAB3A SEC FFD8| E5 FB SBC NLEFT FFDA| 4C 2FDF JMP HTABA FFDD| FFDD| FFDD| 00 00 00 00 00 .BYTE 0,0,0,0,0 FFE2| FFE2| 30DA A_GENIT .WORD GENIT ; GENIT: Init serial card. FFE4| FFE4| ; Shift translation tables: If the character in S_TBL is FFE4| ; found during character processing, the corresponding FFE4| ; byte in S_VAL is used. FFE4| 0B 0C 0F 5D 5E 40 1D S_TBL .BYTE 00B,00C,00F,05D,05E,040,01D,01E,000 FFEB| 1E 00 FFED| ; Ctrl-K -L -O ] ^ @ -] -^ -@ FFED| 5B 0A 0B 4D 4E 50 5D S_VAL .BYTE 05B,00A,00B,04D,04E,050,05D,05E,040 FFF4| 5E 40 FFF6| ; [ -J -K M N P ] ^ @ FFF6| FFF6| 0400 LFFF6 .WORD 4 ; Version word (Pascal 1.3) FFF8| ECFE LFFF8 .WORD TOSTART ; Start vector FFFA| E6FE LFFFA .WORD TOXIT ; Non-Maskable Interrupt FFFC| E6FE LFFFC .WORD TOXIT ; Reset vector FFFE| E6FE LFFFE .WORD TOXIT ; IRQ vector 0000| 0000| 0000| 0000| ;================================================================= 0000| 0000| .END AB - Absolute LB - Label UD - Undefined MC - Macro RF - Ref DF - Def PR - Proc FC - Func PB - Public PV - Private CS - Consts ABI LB D762| ABR LB F2D3| ACSTART LB F8C6| ADDFL LB F034| ADI LB D780| ADJ LB DD66| ADJUST LB EFF9 ADR LB F0E3| AE2E4 LB E2EF| AFTNPRO AB BF23| AGENIT LB FFE2| AIBU LB F4CB| AIMRST LB FE78| AINTDV1 LB FE00 AINTERP LB D1D7| ARTBL LB F8C1| ASEGTB1 LB E682| ASEGTB2 LB F841| ASMRTN LB E2E4| ASTKSTR LB F83F| ASYSCOM LB F843 ATAN LB D225| AURETRN LB F817| AWTBL LB F8BF| AXIT LB F845| AZ88 LB DFED| AZ8A LB DFEF| BAD LB EFD5 BASE AB 0050| BCOMP LB DF9F| BIG AB 0068| BIOS LB FF00| BIOSAF LB FF5C| BITVAL LB DE39| BOCOMP LB E0A3 BOMBIPC AB BD34| BOMBP AB BD28| BOMBPN AB BD2E| BOMBSN AB BD30| BPT LB EE46| BREAK AB BF16| BUMPEX LB EF9B BUTN0 AB C061| CALCFREE LB E65E| CALLIND LB E2F1| CALLSETU LB E278| CALLUTIL LB E262| CBP LB E508| CGP LB E4B4 CHK LB D929| CHK0 LB E186| CHKA0 LB E184| CHKB0 LB E17B| CHKBUT0 AB BF11| CHKGDRP LB D1BA| CHKSTK LB E645 CINIT AB D9F8| CIP LB E432| CKDSKSL AB DD4D| CLP LB E492| CODELOW AB 0062| CODEOVFL LB D219| CODEP AB 0060 COMPARE LB DF71| COMPSR LB E5E8| COMPTYPE AB BF31| CONCK AB D899| CONCKVEC AB BF0A| CONFLGS AB 00FA| COS LB D225 CPOPR1 AB 007E| CPOPR2 AB 0080| CPRSLT AB 008E| CPTYPE AB 0076| CREAD AB DB3B| CSBUFFR AB 6000| CSCHKDIR LB FBA6 CSCKSUM LB FD8F| CSCODE AB 6800| CSDST AB 0002| CSFL LB F093| CSOFFSET LB 90EF| CSP LB EC92| CSPNT AB 00BD CSPTBL LB D100| CSRDPT AB 008A| CSSLTPT AB 00C5| CSSRC AB 0000| CSSUMVL AB 00D0| CSTART LB F8EF| CSTAT AB DBCA CURSFLAG AB BF12| CWRITE AB DA9F| CXP LB E4D1| CXP1 LB E4F4| CXPUTIL LB E247| DECNP LB E63B| DECNR LB EC2C DECPA LB EC38| DECRV LB EC38| DEST AB 0074| DIF LB DCD8| DINIT AB DA84| DISKNUM LB FEB0| DIVBY0 LB D209 DOMOV LB EEF3| DORESET LB FE47| DOURD LB F82E| DOUWR LB F81D| DREAD AB D003| DSKFLG AB BF33| DSMODE AB 00E1 DSTATT AB DC68| DVI LB D8E4| DVIMOD LB D840| DVR LB F17B| DWRITE AB D000| EFJ LB D225| ENDSTK AB BD32 EOFCH AB BD70| EQU LB DF6F| EQUI LB E0F2| EXECERR LB D231| EXIT LB ED75| EXP LB D225| EXUNCALL LB D1E9 FCADDR AB 0074| FCNUMCH AB 0068| FEXP AB 0001| FGOBK LB EFBA| FINDS LB D978| FIXSET LB DC7C| FJP LB D2C7 FLAVOR AB BF22| FLC LB ECA3| FLO LB F360| FLOATI LB F301| FLPTERR LB D229| FLT LB F383| FMANT1 AB 0002 FMANT2 AB 0003| FMANT3 AB 0004| FMANT4 AB 0005| FORM AB DE71| FPMUL LB F207| FPTEMP AB 0090| FPWORK1 AB 007E FPWORK2 AB 0084| FPWORK3 AB 008A| FRETN AB 0092| FSIGN AB 0000| FSYSCOM AB 00F8| FTNPRO AB BF56| FTRRO LB F38E GDIRP AB BD26| GENIT AB DA30| GEQ LB DF67| GEQI LB E0C4| GETBIG LB D155| GETBIGXY LB D17A| GOBACK LB FFB8 GREATER LB F0BF| GRINIT AB DA3F| GRT LB DF5F| GTRI LB E0BC| HIGHESTC LB F84D| HLT LB EE4E| HTAB LB FFCB HTAB1 LB FFD1| HTABA AB DF2F| IBREAK AB BF1D| ICOMFLS LB E123| IDS LB D225| IM LB FE02| IMAREG LB FE7A IMRESET LB FE4A| IMSLOTN LB FE7B| INCNP LB E631| IND LB DAE0| INN LB DDDC| INSRTMSG LB F84F| INT LB DCA1 INTBYUSR LB D20D| INTCOMP LB E0CA| INTERP LB D1D9| INTOVFL LB D205| INTSTART LB D152| INVERT AB DAC8| IOC LB F525 IOERR LB D215| IOR LB F51A| IORSLT AB BD1E| IORTS LB FF58| IPC AB 0058| IPSH01 LB E136| IPSHEQ LB E130 IPSHGT LB E134| IPSHLT LB E12C| ISYSCOM AB BF1F| IXA LB DB0F| IXP LB DB4E| IXS LB DABD| JMPTBL LB D000 JSRCONCK LB F9A1| JTAB AB 0054| KBD AB C000| KBDSTRB AB C010| KCONCK LB FF36| KEYCOUNT AB BF15| KP AB 005C KPSUBD LB FF3C| KUDRWI LB FF39| LAE LB D4C5| LAND LB D603| LAO LB D3AA| LASTMP AB BD2C| LCBANK1 AB C08B LCBANK2 AB C083| LDB LB D5BB| LDC LB D515| LDCI LB D310| LDCN LB D309| LDE LB D46F| LDE5F LB DE5F LDF19 LB DF19| LDF1A LB DF1A| LDF1B LB DF1B| LDF1C LB DF1C| LDF3B LB DF3B| LDF3C LB DF3C| LDL LB D32C LDM LB D552| LDO LB D38E| LDP LB DB9D| LDS LB EC7E| LE441 LB E441| LE517 LB E517| LE55A LB E55A LE67C LB E67C| LE67F LB E67F| LE7E6 LB E7E6| LE9DA LB E9DA| LEB97 LB EB97| LEC21 LB EC21| LECA0 LB ECA0 LEE78 LB EE78| LEEF7 LB EEF7| LEF1A LB EF1A| LEQ LB DF6B| LEQI LB E0C0| LES LB DF63| LESI LB E0B8 LESSEQ LB F0BB| LF847 LB F847| LF848 LB F848| LF9A5 LB F9A5| LF9B0 LB F9B0| LF9DD LB F9DD| LF9E8 LB F9E8 LF9F3 LB F9F3| LF9F8 LB F9F8| LF9FA LB F9FA| LF9FC LB F9FC| LF9FE LB F9FE| LFADD LB FADD| LFB07 LB FB07 LFB0C LB FB0C| LFCAF LB FCAF| LFDAD LB FDAD| LFDF8 LB FDF8| LFEF8 LB FEF8| LFF00 LB FF00| LFF03 LB FF03 LFF06 LB FF06| LFF09 LB FF09| LFF0C LB FF0C| LFF0F LB FF0F| LFF12 LB FF12| LFF15 LB FF15| LFF18 LB FF18 LFF1B LB FF1B| LFF1E LB FF1E| LFF21 LB FF21| LFF24 LB FF24| LFF27 LB FF27| LFF2A LB FF2A| LFF2D LB FF2D LFF30 LB FF30| LFF33 LB FF33| LFF59 LB FF59| LFFF6 LB FFF6| LFFF8 LB FFF8| LFFFA LB FFFA| LFFFC LB FFFC LFFFE LB FFFE| LFFLAG AB BF0F| LLA LB D348| LN LB D225| LNOT LB D635| LOADCS LB F8C8| LOADSEG LB E7CD LOD LB D3E3| LOG LB D225| LOR LB D61C| LOWESTCO LB F84B| LPA LB D9A8| LSA LB D9CE| LSA1 LB D9ED MAINLOOP LB D2B4| MCHCNT LB F84A| MEMAV LB EF25| MODI LB D911| MOV LB D5EF| MP AB 0052| MPI LB D7ED MPR LB F276| MRK LB D712| MULTIPLY LB D7C6| MVL LB EEBB| MVR LB EEBB| NEED128M LB F8A9| NEQ LB DF5B NEQI LB E0C8| NEW LB D6D6| NEWKP AB 0088| NFJ LB D225| NGI LB D79A| NGR LB F2E1| NLEFT AB 00FB NOPROC LB D1E5| NORMLZE LB EFBB| NOT0 LB F089| NOTASMB LB E2F2| NP AB 005A| NUMRELOC AB 00BA| NXTREF AB 009A OLDKP AB 0084| PATBL AB 0086| PDICT AB 007E| PINC LB DAFC| PINIT AB DA27| PLDA LB D40F| PMACH13 PR ---- PNOP LB D2AE| POPFL LB EF4A| POT LB F406| POTTBL LB F42F| PREVMP AB 006C| PROCNUM AB 0082| PSTAT AB DBFB PSUBDR1 LB FF48| PSUBDRV LB FF3F| PUSHBOOL LB E055| PUSHEQ LB E04F| PUSHFL LB EF78| PUSHGT LB E053| PUSHLT LB E04B PWRITE AB DAD1| RANDH AB BF14| RANDL AB BF13| RBP LB E53F| RCOMP LB E069| RDCARDRA AB C003| RDCXROM AB C015 RDLCBNK2 AB C011| RDMAINRA AB C002| RDPAGE2 AB C01C| RDRAMRD AB C013| RDRAMWRT AB C014| READSEG LB E684| READTBL LB F4DE RELOC LB E5F9| RELVAL AB 0086| RETH AB BF1B| RETL AB BF1A| RINIT AB DA43| RLS LB D729| RND LB F3DC RNGERR LB D1E1| RNP LB E554| ROMIDBYT AB FBC0| ROMIN AB C081| ROMVERSI AB FBB3| ROUND LB EFDB| RPTR AB BF18 RREAD AB DB8A| RSTAT AB DC15| RTPTR AB 00E4| RTS2 LB EFDA| RTS3 LB EFF8| RTS4 LB F033| RUNTIME AB 0000 RWRITE AB DB01| SAS LB DA76| SAVERET LB FF9B| SAVERET2 LB FFC8| SBI LB D7AC| SBR LB F12A| SCDIFAB AB 0090 SCEXIT LB E232| SCFALSE LB E231| SCMINAB AB 0088| SCN LB ECE8| SCOMP LB DFF1| SCRMODE AB BF0E| SCRTN AB 0098 SCRTN0 AB 0096| SCSETA AB 007E| SCSETB AB 008A| SCSETUP LB E141| SCSIZEA AB 0084| SCSIZEB AB 0086| SEG AB 0056 SEGADDR AB BC9E| SEGCALL AB BB9E| SEGNUM AB 0090| SEGTABLE AB BD7E| SEGTOS AB BC1E| SEGTYPE AB BB5E| SETALLGR AB C052 SETALTCH AB C00F| SETALTZP AB C009| SETCOMP LB E1CD| SETCOMR LB E198| SETEQL LB E1E3| SETGEQ LB E1F5| SETHIRES AB C057 SETINTCX AB C007| SETLEQ LB E210| SETNEQ LB E1E9| SETSLOTC AB C006| SETSTDZP AB C008| SETTXTMO AB C051| SGS LB DE41 SIG1 LB FD9D| SIG2 LB FDA1| SIN LB D225| SIND LB D4E7| SIND0 LB D4EA| SLDC LB D295| SLDL LB D31F SLDO LB D381| SLTTYPS AB BF27| SNXTSEG AB 008C| SOURCE AB 0072| SPCHAR AB BF1C| SQI LB D834| SQR LB F29E SQRT LB D225| SRET AB 0098| SRO LB D3C7| SRS LB DE53| STACK AB 0100| STARTSTA AB BB5C| STB LB D5D5 STBL LB FFE4| STE LB D49A| STKBASE AB BD2A| STKOVFL LB D1ED| STL LB D365| STM LB D587| STO LB D4FB STP LB DBF3| STR LB D443| STROVFL LB D22D| STRP AB 005E| SUBADR AB 009A| SUBFL LB F05A| SVAL LB FFED SYSIOERR LB D211| SYSPASMS LB F88E| SYSUNIT AB BD22| TAB3 LB FFD5| TAB3A LB FFD7| TIM LB EE5C| TNC LB F3F1 TOBREAK LB FEF2| TOCKDSK LB FF56| TOFORM LB FF52| TOGENIT LB F8C3| TOINV LB FF54| TOSTART LB FEEC| TOXIT LB FEE6 TRS LB D225| TRVSTAT LB D19B| TT1 AB 00D2| TT2 AB 00D3| TT3 AB 00D4| TXTPAGE1 AB C054| TXTPAGE2 AB C055 UBADR AB 0084| UBFLN AB 0082| UBLKNM AB 0080| UBUSY LB F530| UCLR LB F5C3| UCLR1 LB F5DB| UCLR2 LB F5F7 UCLR3 LB F600| UCONWD AB 008C| UDJMPVEC LB FE80| UDJVP AB 00E8| UDLEFLG AB 0088| UDOWR LB F7BE| UDRWI LB FED8 UGOBCK LB F654| UJP LB D2D1| ULFFLG AB 008A| ULS LB EC88| UMODE AB 008C| UNDLF AB 00A0| UNI LB DCFA UNIMPL LB D225| UNITIO LB F694| UNLOADSE LB EC44| UNUMBK AB 0098| UPIPC1 LB D2AE| UPIPC2 LB D288| UPIPC3 LB D27B URADR AB 0084| URDADR AB 0090| UREAD LB F68D| URETRN LB F819| URTN AB 0098| URWBUMP LB F7C5| URWGO LB F7CD URWTOP LB F782| USERDEV LB F5D2| USETGO LB F64E| USETGO1 LB F684| USETSTK LB F65A| USPCH LB F4CD| USPCHK LB F7D6 USRDVR LB F5EE| USTAT LB F548| UTEMP AB 0086| UTEMP1 AB 0096| UUNIT AB 008E| UVALID LB F4EE| UWAIT LB F53E UWRADR AB 0094| UWRT LB F692| VERSION AB BF21| WAITCNT LB F849| WBCOM LB DFB0| WCOMP LB DFAB| WPTR AB BF19 WRCARDRA AB C005| WRITTBL LB F4CE| WRMAINRA AB C004| WTPTR AB 00E6| XEQERR AB BD20| XIT LB D747| XITLOC AB BF2F XJP LB D642| Z40 AB 0040| Z64 AB 0064| Z66 AB 0066| Z6E AB 006E| Z70 AB 0070| Z76 AB 0076 Z7E AB 007E| Z80 AB 0080| Z82 AB 0082| Z84 AB 0084| Z86 AB 0086| Z88 AB 0088| Z8A AB 008A Z8C AB 008C| Z8E AB 008E| Z90 AB 0090| Z92 AB 0092| Z94 AB 0094| Z96 AB 0096| Z9A AB 009A ZB8 AB 00B8| ZPVEC LB FDA5| Current minimum space is 12977 words. Assembly complete: 9665 lines 0 Errors flagged on this Assembly